packages feed

keiro-dsl 0.16.0.0 → 0.17.0.0

raw patch · 765 files changed

+48982/−25848 lines, 765 filesdep +streamly-coredep ~aesondep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: streamly-core

Dependency ranges changed: aeson, bytestring, containers, hasql-transaction, keiro, keiro-core, kiroku-store, shibuya-core

API changes (from Hackage documentation)

- Keiro.Dsl.Grammar: [handle] :: ProcessNode -> !HandleNode
- Keiro.Dsl.NominalType: instance GHC.Classes.Eq Keiro.Dsl.NominalType.ConsumerNominalBinding
- Keiro.Dsl.NominalType: instance GHC.Classes.Eq Keiro.Dsl.NominalType.NominalScalarRepresentation
- Keiro.Dsl.NominalType: instance GHC.Classes.Ord Keiro.Dsl.NominalType.ConsumerNominalBinding
- Keiro.Dsl.NominalType: instance GHC.Classes.Ord Keiro.Dsl.NominalType.NominalScalarRepresentation
- Keiro.Dsl.NominalType: instance GHC.Internal.Generics.Generic Keiro.Dsl.NominalType.ConsumerNominalBinding
- Keiro.Dsl.NominalType: instance GHC.Internal.Generics.Generic Keiro.Dsl.NominalType.NominalScalarRepresentation
- Keiro.Dsl.NominalType: instance GHC.Internal.Show.Show Keiro.Dsl.NominalType.ConsumerNominalBinding
- Keiro.Dsl.NominalType: instance GHC.Internal.Show.Show Keiro.Dsl.NominalType.NominalScalarRepresentation
- Keiro.Dsl.RouterSelection: instance GHC.Internal.Enum.Bounded Keiro.Dsl.RouterSelection.SelectionScalarType
- Keiro.Dsl.RouterSelection: instance GHC.Internal.Enum.Enum Keiro.Dsl.RouterSelection.SelectionScalarType
+ Keiro.Dsl.AggregateType: lookupAggregateNominal :: Name -> AggregateSymbols -> Maybe ResolvedNominalType
+ Keiro.Dsl.CanonicalEncoding: canonicalReactionSurface :: ReactionBody -> Text
+ Keiro.Dsl.CheckReport: CheckReportProcessReaction :: !Text -> !Text -> !Natural -> !Text -> ![Text] -> CheckReportProcessReaction
+ Keiro.Dsl.CheckReport: [fingerprint] :: CheckReportProcessReaction -> !Text
+ Keiro.Dsl.CheckReport: [holeObligations] :: CheckReportProcessReaction -> ![Text]
+ Keiro.Dsl.CheckReport: [process] :: CheckReportProcessReaction -> !Text
+ Keiro.Dsl.CheckReport: [verification] :: CheckReportProcessReaction -> !Text
+ Keiro.Dsl.CheckReport: [version] :: CheckReportProcessReaction -> !Natural
+ Keiro.Dsl.CheckReport: data CheckReportProcessReaction
+ Keiro.Dsl.CheckReport: instance GHC.Classes.Eq Keiro.Dsl.CheckReport.CheckReportProcessReaction
+ Keiro.Dsl.CheckReport: instance GHC.Internal.Show.Show Keiro.Dsl.CheckReport.CheckReportProcessReaction
+ Keiro.Dsl.ConsumerTypePlan: [nominalDependencies] :: ConsumerTypePlan -> !Set Text
+ Keiro.Dsl.CoordinationImpact: ProcessReactionDrift :: !Name -> !Maybe ProcessReactionSnapshot -> !Maybe ProcessReactionSnapshot -> ProcessReactionDrift
+ Keiro.Dsl.CoordinationImpact: ProcessReactionSnapshot :: !Name -> !Text -> !Maybe Natural -> !Maybe Text -> ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: [currentReaction] :: ProcessReactionDrift -> !Maybe ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: [previousReaction] :: ProcessReactionDrift -> !Maybe ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: [process] :: ProcessReactionDrift -> !Name
+ Keiro.Dsl.CoordinationImpact: data ProcessReactionDrift
+ Keiro.Dsl.CoordinationImpact: data ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: instance Data.Aeson.Types.FromJSON.FromJSON Keiro.Dsl.CoordinationImpact.ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: instance Data.Aeson.Types.ToJSON.ToJSON Keiro.Dsl.CoordinationImpact.ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: instance GHC.Classes.Eq Keiro.Dsl.CoordinationImpact.ProcessReactionDrift
+ Keiro.Dsl.CoordinationImpact: instance GHC.Classes.Eq Keiro.Dsl.CoordinationImpact.ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: instance GHC.Classes.Ord Keiro.Dsl.CoordinationImpact.ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: instance GHC.Internal.Generics.Generic Keiro.Dsl.CoordinationImpact.ProcessReactionDrift
+ Keiro.Dsl.CoordinationImpact: instance GHC.Internal.Generics.Generic Keiro.Dsl.CoordinationImpact.ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: instance GHC.Internal.Show.Show Keiro.Dsl.CoordinationImpact.ProcessReactionDrift
+ Keiro.Dsl.CoordinationImpact: instance GHC.Internal.Show.Show Keiro.Dsl.CoordinationImpact.ProcessReactionSnapshot
+ Keiro.Dsl.CoordinationImpact: processReactionDrift :: [ProcessReactionSnapshot] -> [ProcessReactionSnapshot] -> [ProcessReactionDrift]
+ Keiro.Dsl.CoordinationImpact: processReactionSnapshots :: CheckedService -> Either (NonEmpty Text) [ProcessReactionSnapshot]
+ Keiro.Dsl.CoordinationImpact: renderProcessReactionDrift :: [ProcessReactionDrift] -> [Text]
+ Keiro.Dsl.Coverage: NominalBoundary :: !Text -> !Text -> !Text -> !Text -> !Text -> !Maybe Text -> !Maybe Text -> !Maybe Text -> !Text -> NominalBoundary
+ Keiro.Dsl.Coverage: [domainVersion] :: NominalBoundary -> !Maybe Text
+ Keiro.Dsl.Coverage: [kind] :: NominalBoundary -> !Text
+ Keiro.Dsl.Coverage: [nominalBoundaries] :: CoverageReport -> ![NominalBoundary]
+ Keiro.Dsl.Coverage: [nominal] :: NominalBoundary -> !Text
+ Keiro.Dsl.Coverage: [ownership] :: NominalBoundary -> !Text
+ Keiro.Dsl.Coverage: [position] :: NominalBoundary -> !Text
+ Keiro.Dsl.Coverage: [prefix] :: NominalBoundary -> !Maybe Text
+ Keiro.Dsl.Coverage: data NominalBoundary
+ Keiro.Dsl.Coverage: instance Data.Aeson.Types.ToJSON.ToJSON Keiro.Dsl.Coverage.NominalBoundary
+ Keiro.Dsl.Coverage: instance GHC.Classes.Eq Keiro.Dsl.Coverage.NominalBoundary
+ Keiro.Dsl.Coverage: instance GHC.Classes.Ord Keiro.Dsl.Coverage.NominalBoundary
+ Keiro.Dsl.Coverage: instance GHC.Internal.Show.Show Keiro.Dsl.Coverage.NominalBoundary
+ Keiro.Dsl.Diff: [newService] :: DiffEnv -> !CheckedService
+ Keiro.Dsl.Diff: [newValidationErrors] :: DiffEnv -> ![Diagnostic]
+ Keiro.Dsl.Diff: [oldService] :: DiffEnv -> !CheckedService
+ Keiro.Dsl.Diff: instance GHC.Classes.Eq Keiro.Dsl.Diff.GuardProposal
+ Keiro.Dsl.Diff: instance GHC.Classes.Eq Keiro.Dsl.Diff.NominalUse
+ Keiro.Dsl.Diff: instance GHC.Classes.Ord Keiro.Dsl.Diff.NominalUse
+ Keiro.Dsl.Diff: instance GHC.Internal.Show.Show Keiro.Dsl.Diff.GuardProposal
+ Keiro.Dsl.Diff: instance GHC.Internal.Show.Show Keiro.Dsl.Diff.NominalUse
+ Keiro.Dsl.Expression: ScalarNominalOperatorUnsupported :: ExpressionDiagnosticCode
+ Keiro.Dsl.Expression: ScalarNominalTypeMismatch :: ExpressionDiagnosticCode
+ Keiro.Dsl.Expression: [terminalNominal] :: ResolvedScalarProjection -> !Maybe NominalLeaf
+ Keiro.Dsl.Grammar: AdvanceReaction :: !Name -> ![FieldBinding] -> !Maybe [FollowUp] -> !Bool -> !Loc -> AdvanceReaction
+ Keiro.Dsl.Grammar: ArmActions :: !Maybe AdvanceReaction -> ![FollowUp] -> ArmBody
+ Keiro.Dsl.Grammar: CDeclaredId :: !Name -> ContractType
+ Keiro.Dsl.Grammar: FollowCancel :: !Name -> !Loc -> FollowUp
+ Keiro.Dsl.Grammar: FollowDispatch :: !DispatchNode -> FollowUp
+ Keiro.Dsl.Grammar: FollowSchedule :: !ScheduleNode -> FollowUp
+ Keiro.Dsl.Grammar: IdemDelegated :: IdempotenceMode
+ Keiro.Dsl.Grammar: IdemInboxTable :: IdempotenceMode
+ Keiro.Dsl.Grammar: LegacyProcessBody :: !InputDecl -> !HandleNode -> !TimerNode -> ProcessBody
+ Keiro.Dsl.Grammar: NoAction :: ArmBody
+ Keiro.Dsl.Grammar: OtherwiseArm :: ArmGuard
+ Keiro.Dsl.Grammar: PayloadConstant :: !Name -> !Text -> PayloadField
+ Keiro.Dsl.Grammar: PayloadTyped :: !Name -> !Maybe Name -> PayloadField
+ Keiro.Dsl.Grammar: ReactionArm :: !ArmGuard -> !ArmBody -> !Loc -> ReactionArm
+ Keiro.Dsl.Grammar: ReactionBody :: !Natural -> !Loc -> !NonEmpty InputDecl -> !NonEmpty ReactionNode -> !Maybe TimerPolicy -> ![ReactionTimerNode] -> ReactionBody
+ Keiro.Dsl.Grammar: ReactionNode :: !Name -> !NonEmpty ReactionArm -> !Loc -> ReactionNode
+ Keiro.Dsl.Grammar: ReactionProcessBody :: !ReactionBody -> ProcessBody
+ Keiro.Dsl.Grammar: ReactionTimerNode :: !Name -> !IdExpr -> ![PayloadField] -> !FireNode -> !Name -> !Loc -> ReactionTimerNode
+ Keiro.Dsl.Grammar: ScheduleNode :: !Name -> !ScheduleMode -> !FireAtExpr -> ![FieldBinding] -> !Loc -> ScheduleNode
+ Keiro.Dsl.Grammar: ScheduleOnce :: ScheduleMode
+ Keiro.Dsl.Grammar: ScheduleRearm :: ScheduleMode
+ Keiro.Dsl.Grammar: TKeyedMap :: !Name -> !TypeExpr -> TypeExpr
+ Keiro.Dsl.Grammar: TimerPolicy :: !Int -> !Text -> !Loc -> TimerPolicy
+ Keiro.Dsl.Grammar: UnconditionalArm :: ArmGuard
+ Keiro.Dsl.Grammar: WhenArm :: !Expr -> ArmGuard
+ Keiro.Dsl.Grammar: WqFifoHeads :: WqOrdering
+ Keiro.Dsl.Grammar: [accepted] :: AdvanceReaction -> !Maybe [FollowUp]
+ Keiro.Dsl.Grammar: [arms] :: ReactionNode -> !NonEmpty ReactionArm
+ Keiro.Dsl.Grammar: [bindings] :: ScheduleNode -> ![FieldBinding]
+ Keiro.Dsl.Grammar: [followUps] :: ArmBody -> ![FollowUp]
+ Keiro.Dsl.Grammar: [idempotence] :: IntakeNode -> !IdempotenceMode
+ Keiro.Dsl.Grammar: [inputs] :: ReactionBody -> !NonEmpty InputDecl
+ Keiro.Dsl.Grammar: [reactions] :: ReactionBody -> !NonEmpty ReactionNode
+ Keiro.Dsl.Grammar: [silentNoAction] :: AdvanceReaction -> !Bool
+ Keiro.Dsl.Grammar: [timerPolicy] :: ReactionBody -> !Maybe TimerPolicy
+ Keiro.Dsl.Grammar: [timers] :: ReactionBody -> ![ReactionTimerNode]
+ Keiro.Dsl.Grammar: data AdvanceReaction
+ Keiro.Dsl.Grammar: data ArmBody
+ Keiro.Dsl.Grammar: data ArmGuard
+ Keiro.Dsl.Grammar: data FollowUp
+ Keiro.Dsl.Grammar: data IdempotenceMode
+ Keiro.Dsl.Grammar: data PayloadField
+ Keiro.Dsl.Grammar: data ProcessBody
+ Keiro.Dsl.Grammar: data ReactionArm
+ Keiro.Dsl.Grammar: data ReactionBody
+ Keiro.Dsl.Grammar: data ReactionNode
+ Keiro.Dsl.Grammar: data ReactionTimerNode
+ Keiro.Dsl.Grammar: data ScheduleMode
+ Keiro.Dsl.Grammar: data ScheduleNode
+ Keiro.Dsl.Grammar: data TimerPolicy
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.AdvanceReaction
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ArmBody
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ArmGuard
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.FollowUp
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.IdempotenceMode
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.PayloadField
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ProcessBody
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ReactionArm
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ReactionBody
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ReactionNode
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ReactionTimerNode
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ScheduleMode
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.ScheduleNode
+ Keiro.Dsl.Grammar: instance GHC.Classes.Eq Keiro.Dsl.Grammar.TimerPolicy
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.AdvanceReaction
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ArmBody
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ArmGuard
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.FollowUp
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.IdempotenceMode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.PayloadField
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ProcessBody
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ReactionArm
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ReactionBody
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ReactionNode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ReactionTimerNode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ScheduleMode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.ScheduleNode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Generics.Generic Keiro.Dsl.Grammar.TimerPolicy
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.AdvanceReaction
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ArmBody
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ArmGuard
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.FollowUp
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.IdempotenceMode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.PayloadField
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ProcessBody
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ReactionArm
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ReactionBody
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ReactionNode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ReactionTimerNode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ScheduleMode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.ScheduleNode
+ Keiro.Dsl.Grammar: instance GHC.Internal.Show.Show Keiro.Dsl.Grammar.TimerPolicy
+ Keiro.Dsl.Harness: harnessProcessForService :: Context -> CheckedService -> ProcessNode -> [ScaffoldModule]
+ Keiro.Dsl.Harness: processHarnessFactValuesForService :: CheckedService -> ProcessNode -> [(Text, Text)]
+ Keiro.Dsl.LanguageVersion: ContractDeclaredIdSyntax :: LanguageFeature
+ Keiro.Dsl.LanguageVersion: DelegatedInboxRuntime :: RuntimeCapability
+ Keiro.Dsl.LanguageVersion: DelegatedInboxSyntax :: LanguageFeature
+ Keiro.Dsl.LanguageVersion: KeyedMapSyntax :: LanguageFeature
+ Keiro.Dsl.LanguageVersion: ProcessReactionSyntax :: LanguageFeature
+ Keiro.Dsl.LanguageVersion: StructuralNominalLeaves :: RuntimeCapability
+ Keiro.Dsl.LanguageVersion: WorkqueueFifoHeadsSyntax :: LanguageFeature
+ Keiro.Dsl.MappedCodecPlan: NominalAuthority :: !Text -> MappedAuthorityMode
+ Keiro.Dsl.PrettyPrint: renderReactionArmBodySurface :: ReactionArm -> Text
+ Keiro.Dsl.PrettyPrint: renderReactionArmGuardSurface :: ReactionArm -> Text
+ Keiro.Dsl.PrettyPrint: renderReactionArmSurface :: ReactionArm -> Text
+ Keiro.Dsl.PrettyPrint: renderReactionSurface :: ReactionBody -> Text
+ Keiro.Dsl.PrettyPrint: renderReactionTimerPayloadSurface :: ReactionTimerNode -> Text
+ Keiro.Dsl.ProcessReaction: CheckedFollowUp :: FollowUp -> CheckedFollowUp
+ Keiro.Dsl.ProcessReaction: CheckedOtherwise :: CheckedReactionGuard
+ Keiro.Dsl.ProcessReaction: CheckedProcessReaction :: !Natural -> !NonEmpty InputDecl -> ![CheckedReactionArm] -> ![CheckedReactionTimer] -> !Text -> !Text -> ![Text] -> CheckedProcessReaction
+ Keiro.Dsl.ProcessReaction: CheckedReactionArm :: !Name -> !Int -> !CheckedReactionGuard -> !ArmBody -> CheckedReactionArm
+ Keiro.Dsl.ProcessReaction: CheckedReactionTimer :: ReactionTimerNode -> CheckedReactionTimer
+ Keiro.Dsl.ProcessReaction: CheckedUnconditional :: CheckedReactionGuard
+ Keiro.Dsl.ProcessReaction: CheckedWhen :: !Expr -> CheckedReactionGuard
+ Keiro.Dsl.ProcessReaction: ProcessAcceptedArmRequiresEvent :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessAcceptedArmUnverified :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessBindingTypeMismatch :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessCancelUnknownTimer :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessInputDuplicateDeclaration :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessReactionDiagnostic :: !Loc -> !ProcessReactionDiagnosticCode -> !Text -> ProcessReactionDiagnostic
+ Keiro.Dsl.ProcessReaction: ProcessReactionDuplicateInput :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessReactionGuardNotBoolean :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessReactionInputUnhandled :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessReactionOtherwiseMissing :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessReactionOtherwiseUnreachable :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessReactionUnknownInput :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessSchedulePayloadIncomplete :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessScheduleUnknownTimer :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessSilentArmMissing :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessStateAccessUnsupported :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessTimerDuplicateName :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessTimerPolicyMissing :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessTimerPolicyUnused :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: ProcessTimerPrefixCollision :: ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: [arms] :: CheckedProcessReaction -> ![CheckedReactionArm]
+ Keiro.Dsl.ProcessReaction: [body] :: CheckedReactionArm -> !ArmBody
+ Keiro.Dsl.ProcessReaction: [code] :: ProcessReactionDiagnostic -> !ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: [fingerprint] :: CheckedProcessReaction -> !Text
+ Keiro.Dsl.ProcessReaction: [guard] :: CheckedReactionArm -> !CheckedReactionGuard
+ Keiro.Dsl.ProcessReaction: [holeObligations] :: CheckedProcessReaction -> ![Text]
+ Keiro.Dsl.ProcessReaction: [input] :: CheckedReactionArm -> !Name
+ Keiro.Dsl.ProcessReaction: [inputs] :: CheckedProcessReaction -> !NonEmpty InputDecl
+ Keiro.Dsl.ProcessReaction: [loc] :: ProcessReactionDiagnostic -> !Loc
+ Keiro.Dsl.ProcessReaction: [message] :: ProcessReactionDiagnostic -> !Text
+ Keiro.Dsl.ProcessReaction: [ordinal] :: CheckedReactionArm -> !Int
+ Keiro.Dsl.ProcessReaction: [syntax] :: CheckedReactionTimer -> ReactionTimerNode
+ Keiro.Dsl.ProcessReaction: [timers] :: CheckedProcessReaction -> ![CheckedReactionTimer]
+ Keiro.Dsl.ProcessReaction: [verification] :: CheckedProcessReaction -> !Text
+ Keiro.Dsl.ProcessReaction: [version] :: CheckedProcessReaction -> !Natural
+ Keiro.Dsl.ProcessReaction: checkProcessReaction :: EffectiveLanguageContract -> TypeGraph -> Spec -> ProcessNode -> Either (NonEmpty ProcessReactionDiagnostic) CheckedProcessReaction
+ Keiro.Dsl.ProcessReaction: data CheckedProcessReaction
+ Keiro.Dsl.ProcessReaction: data CheckedReactionArm
+ Keiro.Dsl.ProcessReaction: data CheckedReactionGuard
+ Keiro.Dsl.ProcessReaction: data ProcessReactionDiagnostic
+ Keiro.Dsl.ProcessReaction: data ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: instance GHC.Classes.Eq Keiro.Dsl.ProcessReaction.CheckedFollowUp
+ Keiro.Dsl.ProcessReaction: instance GHC.Classes.Eq Keiro.Dsl.ProcessReaction.CheckedProcessReaction
+ Keiro.Dsl.ProcessReaction: instance GHC.Classes.Eq Keiro.Dsl.ProcessReaction.CheckedReactionArm
+ Keiro.Dsl.ProcessReaction: instance GHC.Classes.Eq Keiro.Dsl.ProcessReaction.CheckedReactionGuard
+ Keiro.Dsl.ProcessReaction: instance GHC.Classes.Eq Keiro.Dsl.ProcessReaction.CheckedReactionTimer
+ Keiro.Dsl.ProcessReaction: instance GHC.Classes.Eq Keiro.Dsl.ProcessReaction.ProcessReactionDiagnostic
+ Keiro.Dsl.ProcessReaction: instance GHC.Classes.Eq Keiro.Dsl.ProcessReaction.ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: instance GHC.Classes.Ord Keiro.Dsl.ProcessReaction.ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Enum.Bounded Keiro.Dsl.ProcessReaction.ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Enum.Enum Keiro.Dsl.ProcessReaction.ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Show.Show Keiro.Dsl.ProcessReaction.CheckedFollowUp
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Show.Show Keiro.Dsl.ProcessReaction.CheckedProcessReaction
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Show.Show Keiro.Dsl.ProcessReaction.CheckedReactionArm
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Show.Show Keiro.Dsl.ProcessReaction.CheckedReactionGuard
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Show.Show Keiro.Dsl.ProcessReaction.CheckedReactionTimer
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Show.Show Keiro.Dsl.ProcessReaction.ProcessReactionDiagnostic
+ Keiro.Dsl.ProcessReaction: instance GHC.Internal.Show.Show Keiro.Dsl.ProcessReaction.ProcessReactionDiagnosticCode
+ Keiro.Dsl.ProcessReaction: newtype CheckedFollowUp
+ Keiro.Dsl.ProcessReaction: newtype CheckedReactionTimer
+ Keiro.Dsl.ProcessReaction: processReactionFingerprint :: CheckedProcessReaction -> Text
+ Keiro.Dsl.ProcessReaction: processReactionFingerprintFrom :: ReactionBody -> Text
+ Keiro.Dsl.RouterSelection: CheckedIdLiteral :: !Name -> !Text -> CheckedScalarNode
+ Keiro.Dsl.RouterSelection: SelectionNominal :: !Name -> SelectionScalarType
+ Keiro.Dsl.Scaffold: [fixtures] :: StructuralProjection -> !QualifiedValueName
+ Keiro.Dsl.Scaffold: [getter] :: StructuralProjection -> !Text
+ Keiro.Dsl.Scaffold: [rawGetter] :: StructuralProjection -> !Maybe Text
+ Keiro.Dsl.Scaffold: [terminalNominal] :: StructuralProjection -> !Maybe NominalLeaf
+ Keiro.Dsl.ScaffoldRecord: ProcessReactionRecordRow :: !Text -> !Text -> !Maybe Natural -> !Maybe Text -> ![Text] -> ProcessReactionRecordRow
+ Keiro.Dsl.ScaffoldRecord: [fingerprint] :: ProcessReactionRecordRow -> !Maybe Text
+ Keiro.Dsl.ScaffoldRecord: [holeObligations] :: ProcessReactionRecordRow -> ![Text]
+ Keiro.Dsl.ScaffoldRecord: [processName] :: ProcessReactionRecordRow -> !Text
+ Keiro.Dsl.ScaffoldRecord: [processReactions] :: ScaffoldRecord -> ![ProcessReactionRecordRow]
+ Keiro.Dsl.ScaffoldRecord: [verification] :: ProcessReactionRecordRow -> !Text
+ Keiro.Dsl.ScaffoldRecord: [version] :: ProcessReactionRecordRow -> !Maybe Natural
+ Keiro.Dsl.ScaffoldRecord: data ProcessReactionRecordRow
+ Keiro.Dsl.ScaffoldRecord: instance Data.Aeson.Types.FromJSON.FromJSON Keiro.Dsl.ScaffoldRecord.ProcessReactionRecordRow
+ Keiro.Dsl.ScaffoldRecord: instance Data.Aeson.Types.ToJSON.ToJSON Keiro.Dsl.ScaffoldRecord.ProcessReactionRecordRow
+ Keiro.Dsl.ScaffoldRecord: instance GHC.Classes.Eq Keiro.Dsl.ScaffoldRecord.ProcessReactionRecordRow
+ Keiro.Dsl.ScaffoldRecord: instance GHC.Internal.Show.Show Keiro.Dsl.ScaffoldRecord.ProcessReactionRecordRow
+ Keiro.Dsl.ScaffoldRecord: processReactionRowsForService :: CheckedService -> Either (NonEmpty Text) [ProcessReactionRecordRow]
+ Keiro.Dsl.ScaffoldRun: HoleContractDrift :: ![(FilePath, Text, Text)] -> Refusal
+ Keiro.Dsl.ScaffoldRun: ProcessReactionRefusal :: ![Text] -> Refusal
+ Keiro.Dsl.ScaffoldRun: [processReactionCoordinationDrift] :: ScaffoldReport -> ![ProcessReactionDrift]
+ Keiro.Dsl.ScaffoldRun: [processReactionRows] :: ScaffoldReport -> ![ProcessReactionRecordRow]
+ Keiro.Dsl.SourceIndex: ProcessReactionSubject :: !Name -> !Name -> !Int -> SourceSubject
+ Keiro.Dsl.Syntax: SurfaceProcessReaction :: !Name -> !Name -> !Int -> SurfaceElement
+ Keiro.Dsl.TransitionFamily: ReplayBodyAdded :: ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: ReplayBodyChanged :: ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: ReplayBodyDelta :: !TransitionFamilyKey -> !ReplayBodyKey -> ![Transition] -> ![Transition] -> !ReplayBodyStatus -> ReplayBodyDelta
+ Keiro.Dsl.TransitionFamily: ReplayBodyKey :: Text -> ReplayBodyKey
+ Keiro.Dsl.TransitionFamily: ReplayBodyPreserved :: ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: ReplayBodyRemoved :: ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: TransitionFamilyDelta :: !TransitionFamilyKey -> ![Transition] -> ![Transition] -> TransitionFamilyDelta
+ Keiro.Dsl.TransitionFamily: TransitionFamilyKey :: !TransitionMode -> !Name -> !Name -> TransitionFamilyKey
+ Keiro.Dsl.TransitionFamily: [bodyFamilyKey] :: ReplayBodyDelta -> !TransitionFamilyKey
+ Keiro.Dsl.TransitionFamily: [bodyKey] :: ReplayBodyDelta -> !ReplayBodyKey
+ Keiro.Dsl.TransitionFamily: [bodyStatus] :: ReplayBodyDelta -> !ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: [familyCommand] :: TransitionFamilyKey -> !Name
+ Keiro.Dsl.TransitionFamily: [familyKey] :: TransitionFamilyDelta -> !TransitionFamilyKey
+ Keiro.Dsl.TransitionFamily: [familyMode] :: TransitionFamilyKey -> !TransitionMode
+ Keiro.Dsl.TransitionFamily: [familySource] :: TransitionFamilyKey -> !Name
+ Keiro.Dsl.TransitionFamily: [newBodyMembers] :: ReplayBodyDelta -> ![Transition]
+ Keiro.Dsl.TransitionFamily: [newRemainder] :: TransitionFamilyDelta -> ![Transition]
+ Keiro.Dsl.TransitionFamily: [oldBodyMembers] :: ReplayBodyDelta -> ![Transition]
+ Keiro.Dsl.TransitionFamily: [oldRemainder] :: TransitionFamilyDelta -> ![Transition]
+ Keiro.Dsl.TransitionFamily: [unReplayBodyKey] :: ReplayBodyKey -> Text
+ Keiro.Dsl.TransitionFamily: data ReplayBodyDelta
+ Keiro.Dsl.TransitionFamily: data ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: data TransitionFamilyDelta
+ Keiro.Dsl.TransitionFamily: data TransitionFamilyKey
+ Keiro.Dsl.TransitionFamily: guardAlternatives :: NonEmpty (Maybe Expr) -> NonEmpty (Maybe Expr)
+ Keiro.Dsl.TransitionFamily: guardImplies :: Maybe Expr -> Maybe Expr -> Bool
+ Keiro.Dsl.TransitionFamily: guardUnion :: NonEmpty (Maybe Expr) -> Maybe Expr
+ Keiro.Dsl.TransitionFamily: instance GHC.Classes.Eq Keiro.Dsl.TransitionFamily.ReplayBodyDelta
+ Keiro.Dsl.TransitionFamily: instance GHC.Classes.Eq Keiro.Dsl.TransitionFamily.ReplayBodyKey
+ Keiro.Dsl.TransitionFamily: instance GHC.Classes.Eq Keiro.Dsl.TransitionFamily.ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: instance GHC.Classes.Eq Keiro.Dsl.TransitionFamily.TransitionFamilyDelta
+ Keiro.Dsl.TransitionFamily: instance GHC.Classes.Eq Keiro.Dsl.TransitionFamily.TransitionFamilyKey
+ Keiro.Dsl.TransitionFamily: instance GHC.Classes.Ord Keiro.Dsl.TransitionFamily.ReplayBodyKey
+ Keiro.Dsl.TransitionFamily: instance GHC.Classes.Ord Keiro.Dsl.TransitionFamily.ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: instance GHC.Classes.Ord Keiro.Dsl.TransitionFamily.TransitionFamilyKey
+ Keiro.Dsl.TransitionFamily: instance GHC.Internal.Show.Show Keiro.Dsl.TransitionFamily.ReplayBodyDelta
+ Keiro.Dsl.TransitionFamily: instance GHC.Internal.Show.Show Keiro.Dsl.TransitionFamily.ReplayBodyKey
+ Keiro.Dsl.TransitionFamily: instance GHC.Internal.Show.Show Keiro.Dsl.TransitionFamily.ReplayBodyStatus
+ Keiro.Dsl.TransitionFamily: instance GHC.Internal.Show.Show Keiro.Dsl.TransitionFamily.TransitionFamilyDelta
+ Keiro.Dsl.TransitionFamily: instance GHC.Internal.Show.Show Keiro.Dsl.TransitionFamily.TransitionFamilyKey
+ Keiro.Dsl.TransitionFamily: newtype ReplayBodyKey
+ Keiro.Dsl.TransitionFamily: replayBodyDeltas :: [Transition] -> [Transition] -> [ReplayBodyDelta]
+ Keiro.Dsl.TransitionFamily: replayBodyKey :: Transition -> ReplayBodyKey
+ Keiro.Dsl.TransitionFamily: transitionFamilyDeltas :: [Transition] -> [Transition] -> [TransitionFamilyDelta]
+ Keiro.Dsl.TransitionFamily: unionPreserved :: NonEmpty (Maybe Expr) -> NonEmpty (Maybe Expr) -> Bool
+ Keiro.Dsl.TypeGraph: ConsumerLeaf :: !ConsumerNominalBinding -> NominalLeafOwnership
+ Keiro.Dsl.TypeGraph: ConsumerNominalBinding :: !HaskellSource -> !QualifiedValueName -> !BindingVersion -> !CanonicalTypeId -> !QualifiedValueName -> !Maybe QualifiedValueName -> ConsumerNominalBinding
+ Keiro.Dsl.TypeGraph: GeneratedLeaf :: NominalLeafOwnership
+ Keiro.Dsl.TypeGraph: LeafEmptyEnum :: !Name -> !Loc -> NominalLeafIssue
+ Keiro.Dsl.TypeGraph: LeafInvalidHaskellSource :: !Name -> !Loc -> !Text -> NominalLeafIssue
+ Keiro.Dsl.TypeGraph: LeafInvalidIdPrefix :: !Name -> !Loc -> !Text -> !Text -> NominalLeafIssue
+ Keiro.Dsl.TypeGraph: LeafInvalidIdentity :: !Name -> !Loc -> !Text -> !Text -> NominalLeafIssue
+ Keiro.Dsl.TypeGraph: LeafInvalidQualifiedValue :: !Name -> !Loc -> !Text -> !Text -> NominalLeafIssue
+ Keiro.Dsl.TypeGraph: LeafMissingIngredient :: !Name -> !Loc -> !Text -> NominalLeafIssue
+ Keiro.Dsl.TypeGraph: LeafUnsupportedScalar :: !Name -> !Loc -> !Name -> NominalLeafIssue
+ Keiro.Dsl.TypeGraph: NominalBool :: NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: NominalEnumLeaf :: !NonEmpty (Name, Text) -> NominalLeafKind
+ Keiro.Dsl.TypeGraph: NominalIdLeaf :: !Text -> NominalLeafKind
+ Keiro.Dsl.TypeGraph: NominalInt :: NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: NominalLeaf :: !Name -> !NominalLeafKind -> !NominalLeafOwnership -> !Loc -> NominalLeaf
+ Keiro.Dsl.TypeGraph: NominalLeafError :: NonEmpty NominalLeafIssue -> NominalLeafError
+ Keiro.Dsl.TypeGraph: NominalNatural :: NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: NominalRootSite :: !RootRef -> !Name -> ![PathSeg] -> NominalRootSite
+ Keiro.Dsl.TypeGraph: NominalScalarLeaf :: !NominalScalarRepresentation -> NominalLeafKind
+ Keiro.Dsl.TypeGraph: NominalText :: NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: NominalTime :: NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: RKeyedMap :: !NominalLeaf -> !ResolvedTypeExpr -> ResolvedTypeExpr
+ Keiro.Dsl.TypeGraph: RNominal :: !NominalLeaf -> ResolvedTypeExpr
+ Keiro.Dsl.TypeGraph: RootContractField :: !Name -> !Name -> !Name -> RootRef
+ Keiro.Dsl.TypeGraph: SegMapKey :: PathSeg
+ Keiro.Dsl.TypeGraph: SegNominal :: !Name -> PathSeg
+ Keiro.Dsl.TypeGraph: TGUnsupportedNominalLeaf :: !Name -> !Name -> !Text -> !Loc -> TypeGraphError
+ Keiro.Dsl.TypeGraph: UseSite :: !RootRef -> !MappedKey -> UseSite
+ Keiro.Dsl.TypeGraph: [kind] :: NominalLeaf -> !NominalLeafKind
+ Keiro.Dsl.TypeGraph: [mappedKey] :: UseSite -> !MappedKey
+ Keiro.Dsl.TypeGraph: [nominalLeafIssues] :: NominalLeafError -> NonEmpty NominalLeafIssue
+ Keiro.Dsl.TypeGraph: [nominalLeaves] :: TypeGraph -> !Map Name NominalLeaf
+ Keiro.Dsl.TypeGraph: [nominalReachability] :: TypeGraph -> !Map MappedKey (Set Name)
+ Keiro.Dsl.TypeGraph: [nominalRootSites] :: TypeGraph -> ![NominalRootSite]
+ Keiro.Dsl.TypeGraph: [nominal] :: NominalRootSite -> !Name
+ Keiro.Dsl.TypeGraph: [onKeyedMap] :: TypeExprAlgebra a -> NominalLeaf -> a -> a
+ Keiro.Dsl.TypeGraph: [onNominal] :: TypeExprAlgebra a -> NominalLeaf -> a
+ Keiro.Dsl.TypeGraph: [ownership] :: NominalLeaf -> !NominalLeafOwnership
+ Keiro.Dsl.TypeGraph: [unsupportedNominalLeafKinds] :: TypeGraph -> !Map Name Text
+ Keiro.Dsl.TypeGraph: checkEnumLeaf :: EnumDecl -> Either NominalLeafError NominalLeaf
+ Keiro.Dsl.TypeGraph: checkIdLeaf :: IdDecl -> Either NominalLeafError NominalLeaf
+ Keiro.Dsl.TypeGraph: checkScalarLeaf :: NominalScalarDecl -> Either NominalLeafError NominalLeaf
+ Keiro.Dsl.TypeGraph: data ConsumerNominalBinding
+ Keiro.Dsl.TypeGraph: data NominalLeaf
+ Keiro.Dsl.TypeGraph: data NominalLeafIssue
+ Keiro.Dsl.TypeGraph: data NominalLeafKind
+ Keiro.Dsl.TypeGraph: data NominalLeafOwnership
+ Keiro.Dsl.TypeGraph: data NominalRootSite
+ Keiro.Dsl.TypeGraph: data NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: data RootRef
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.ConsumerNominalBinding
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.NominalLeaf
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.NominalLeafError
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.NominalLeafIssue
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.NominalLeafKind
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.NominalLeafOwnership
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.NominalRootSite
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Eq Keiro.Dsl.TypeGraph.RootRef
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Ord Keiro.Dsl.TypeGraph.ConsumerNominalBinding
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Ord Keiro.Dsl.TypeGraph.NominalLeafKind
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Ord Keiro.Dsl.TypeGraph.NominalLeafOwnership
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Ord Keiro.Dsl.TypeGraph.NominalRootSite
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Ord Keiro.Dsl.TypeGraph.NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: instance GHC.Classes.Ord Keiro.Dsl.TypeGraph.RootRef
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.ConsumerNominalBinding
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.NominalLeaf
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.NominalLeafError
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.NominalLeafIssue
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.NominalLeafKind
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.NominalLeafOwnership
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.NominalRootSite
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Generics.Generic Keiro.Dsl.TypeGraph.RootRef
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.ConsumerNominalBinding
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.NominalLeaf
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.NominalLeafError
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.NominalLeafIssue
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.NominalLeafKind
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.NominalLeafOwnership
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.NominalRootSite
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.NominalScalarRepresentation
+ Keiro.Dsl.TypeGraph: instance GHC.Internal.Show.Show Keiro.Dsl.TypeGraph.RootRef
+ Keiro.Dsl.TypeGraph: newtype NominalLeafError
+ Keiro.Dsl.TypeGraph: nominalUsePaths :: TypeGraph -> Name -> [UsePath]
+ Keiro.Dsl.TypeGraph: nominalWireFingerprint :: NominalLeaf -> Text
+ Keiro.Dsl.Validate: AggGuardRelationUnknown :: DiagnosticCode
+ Keiro.Dsl.Validate: AggGuardRemedyUnavailable :: DiagnosticCode
+ Keiro.Dsl.Validate: ContractIdUnknown :: DiagnosticCode
+ Keiro.Dsl.Validate: DelegatedInboxDedupeOnlyPersistence :: DiagnosticCode
+ Keiro.Dsl.Validate: IntakeIdempotenceModeChanged :: DiagnosticCode
+ Keiro.Dsl.Validate: MappedNominalLeafRequiresLanguage :: DiagnosticCode
+ Keiro.Dsl.Validate: MappedNominalLeafUnsupported :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessAcceptedArmRequiresEvent :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessAcceptedArmUnverified :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessBindingTypeMismatch :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessCancelUnknownTimer :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessDispatchIdentityModelChanged :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessInputDuplicateDeclaration :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionAdded :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionArmsReordered :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionDuplicateInput :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionFanOutChanged :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionFingerprintChangedWithVersionBump :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionFingerprintChangedWithoutVersionBump :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionGuardChanged :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionGuardNotBoolean :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionInputUnhandled :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionOtherwiseMissing :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionOtherwiseUnreachable :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionRemoved :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionUnknownInput :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessReactionVersionDecreased :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessSchedulePayloadIncomplete :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessScheduleUnknownTimer :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessSilentArmMissing :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessStateAccessUnsupported :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessTimerAdded :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessTimerCeilingChanged :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessTimerDuplicateName :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessTimerIdentityChanged :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessTimerPolicyMissing :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessTimerPolicyUnused :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessTimerPrefixCollision :: DiagnosticCode
+ Keiro.Dsl.Validate: ProcessTimerRemoved :: DiagnosticCode
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.AdvanceReaction
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ArmBody
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ArmGuard
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.FollowUp
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.IdempotenceMode
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.PayloadField
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ProcessBody
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ReactionArm
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ReactionBody
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ReactionNode
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ReactionTimerNode
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ScheduleMode
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.ScheduleNode
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs Keiro.Dsl.Grammar.TimerPolicy
+ Keiro.Dsl.Workspace: instance Keiro.Dsl.Workspace.HasLocs a => Keiro.Dsl.Workspace.HasLocs (GHC.Internal.Base.NonEmpty a)
- Keiro.Dsl.CheckReport: checkReport :: FilePath -> SourceLanguage -> EffectiveLanguageContract -> CheckReportEnforcement -> [Diagnostic] -> Set DiagnosticCode -> CheckReport
+ Keiro.Dsl.CheckReport: checkReport :: FilePath -> SourceLanguage -> CheckedService -> CheckReportEnforcement -> [Diagnostic] -> Set DiagnosticCode -> CheckReport
- Keiro.Dsl.CheckReport: workspaceCheckReport :: FilePath -> WorkspaceSpec -> EffectiveLanguageContract -> CheckReportEnforcement -> [WorkspaceDiagnostic] -> Set DiagnosticCode -> CheckReport
+ Keiro.Dsl.CheckReport: workspaceCheckReport :: FilePath -> WorkspaceSpec -> CheckedService -> CheckReportEnforcement -> [WorkspaceDiagnostic] -> Set DiagnosticCode -> CheckReport
- Keiro.Dsl.ConsumerTypePlan: ConsumerTypePlan :: !HaskellTypeOccurrence -> ![ImportRequirement] -> !Set MappedKey -> ConsumerTypePlan
+ Keiro.Dsl.ConsumerTypePlan: ConsumerTypePlan :: !HaskellTypeOccurrence -> ![ImportRequirement] -> !Set MappedKey -> !Set Text -> ConsumerTypePlan
- Keiro.Dsl.ConsumerTypePlan: renderConsumerType :: HaskellImportPlan -> TypeGraph -> ResolvedTypeExpr -> Either ConsumerTypePlanError HaskellTypeOccurrence
+ Keiro.Dsl.ConsumerTypePlan: renderConsumerType :: Text -> HaskellImportPlan -> TypeGraph -> ResolvedTypeExpr -> Either ConsumerTypePlanError HaskellTypeOccurrence
- Keiro.Dsl.CoordinationImpact: [fingerprint] :: RouterSelectionSnapshot -> !Maybe Text
+ Keiro.Dsl.CoordinationImpact: [fingerprint] :: ProcessReactionSnapshot -> !Maybe Text
- Keiro.Dsl.CoordinationImpact: [verification] :: RouterSelectionSnapshot -> !SelectionVerification
+ Keiro.Dsl.CoordinationImpact: [verification] :: ProcessReactionSnapshot -> !Text
- Keiro.Dsl.CoordinationImpact: [version] :: RouterSelectionSnapshot -> !Maybe Natural
+ Keiro.Dsl.CoordinationImpact: [version] :: ProcessReactionSnapshot -> !Maybe Natural
- Keiro.Dsl.Coverage: CoverageReport :: !FilePath -> ![CoverageRoot] -> ![StructuralBoundary] -> ![OpaqueBoundary] -> ![JsonBoundary] -> ![SnapshotBoundary] -> ![UnsupportedSurface] -> !CoverageSummary -> ![CoverageFinding] -> !Maybe CoveragePrevious -> !Maybe CoverageDelta -> CoverageReport
+ Keiro.Dsl.Coverage: CoverageReport :: !FilePath -> ![CoverageRoot] -> ![StructuralBoundary] -> ![OpaqueBoundary] -> ![JsonBoundary] -> ![NominalBoundary] -> ![SnapshotBoundary] -> ![UnsupportedSurface] -> !CoverageSummary -> ![CoverageFinding] -> !Maybe CoveragePrevious -> !Maybe CoverageDelta -> CoverageReport
- Keiro.Dsl.Coverage: [canonicalType] :: StructuralBoundary -> !Text
+ Keiro.Dsl.Coverage: [canonicalType] :: NominalBoundary -> !Maybe Text
- Keiro.Dsl.Coverage: [path] :: JsonBoundary -> !Text
+ Keiro.Dsl.Coverage: [path] :: NominalBoundary -> !Text
- Keiro.Dsl.Diff: DiffEnv :: !Spec -> !Spec -> DiffEnv
+ Keiro.Dsl.Diff: DiffEnv :: !Spec -> !Spec -> !CheckedService -> !CheckedService -> ![Diagnostic] -> DiffEnv
- Keiro.Dsl.Expression: ResolvedScalarProjection :: !MappedKey -> !Text -> ![Name] -> ResolvedScalarProjection
+ Keiro.Dsl.Expression: ResolvedScalarProjection :: !MappedKey -> !Text -> ![Name] -> !Maybe NominalLeaf -> ResolvedScalarProjection
- Keiro.Dsl.Grammar: IntakeNode :: !Name -> !Name -> !Name -> ![Name] -> ![BindRow] -> !Name -> !Name -> !InkPersist -> !DecodeSpec -> ![DispositionRow] -> !Loc -> IntakeNode
+ Keiro.Dsl.Grammar: IntakeNode :: !Name -> !Name -> !Name -> ![Name] -> ![BindRow] -> !Name -> !Name -> !IdempotenceMode -> !InkPersist -> !DecodeSpec -> ![DispositionRow] -> !Loc -> IntakeNode
- Keiro.Dsl.Grammar: ProcessNode :: !Name -> !Text -> !InputDecl -> !CorrelateDecl -> !SagaRef -> !Name -> ![Name] -> !HandleNode -> !PolicyChoice -> !PolicyChoice -> !TimerNode -> !Loc -> ProcessNode
+ Keiro.Dsl.Grammar: ProcessNode :: !Name -> !Text -> !CorrelateDecl -> !SagaRef -> !Name -> ![Name] -> !ProcessBody -> !PolicyChoice -> !PolicyChoice -> !Loc -> ProcessNode
- Keiro.Dsl.Grammar: [advance] :: HandleNode -> !AdvanceNode
+ Keiro.Dsl.Grammar: [advance] :: ArmBody -> !Maybe AdvanceReaction
- Keiro.Dsl.Grammar: [deadLetter] :: TimerNode -> !Text
+ Keiro.Dsl.Grammar: [deadLetter] :: TimerPolicy -> !Text
- Keiro.Dsl.Grammar: [decodeUnknown] :: TimerNode -> !Name
+ Keiro.Dsl.Grammar: [decodeUnknown] :: ReactionTimerNode -> !Name
- Keiro.Dsl.Grammar: [fireAt] :: TimerNode -> !FireAtExpr
+ Keiro.Dsl.Grammar: [fireAt] :: ScheduleNode -> !FireAtExpr
- Keiro.Dsl.Grammar: [fire] :: TimerNode -> !FireNode
+ Keiro.Dsl.Grammar: [fire] :: ReactionTimerNode -> !FireNode
- Keiro.Dsl.Grammar: [guard] :: Transition -> !Maybe Expr
+ Keiro.Dsl.Grammar: [guard] :: ReactionArm -> !ArmGuard
- Keiro.Dsl.Grammar: [mode] :: Transition -> !TransitionMode
+ Keiro.Dsl.Grammar: [mode] :: ScheduleNode -> !ScheduleMode
- Keiro.Dsl.Grammar: [on] :: HandleNode -> !Name
+ Keiro.Dsl.Grammar: [on] :: ReactionNode -> !Name
- Keiro.Dsl.Grammar: [timer] :: ProcessNode -> !TimerNode
+ Keiro.Dsl.Grammar: [timer] :: ScheduleNode -> !Name
- Keiro.Dsl.Harness: processHarnessFactValues :: ProcessNode -> [(Text, Text)]
+ Keiro.Dsl.Harness: processHarnessFactValues :: Text -> ProcessNode -> [(Text, Text)]
- Keiro.Dsl.Scaffold: StructuralProjection :: !Text -> !Text -> !Text -> !HaskellSource -> !Text -> !CanonicalTypeId -> !QualifiedValueName -> ![(Text, Text)] -> StructuralProjection
+ Keiro.Dsl.Scaffold: StructuralProjection :: !Text -> !Text -> !Text -> !Maybe Text -> !Text -> !HaskellSource -> !Text -> !CanonicalTypeId -> !QualifiedValueName -> !QualifiedValueName -> !Maybe NominalLeaf -> ![(Text, Text)] -> StructuralProjection
- Keiro.Dsl.ScaffoldRecord: ScaffoldRecord :: !Text -> !Text -> !Text -> !SourceLanguage -> !EffectiveLanguageContract -> !GeneratedHaskellNamingEdition -> ![ScaffoldModuleRoleRow] -> ![(ModuleKind, FilePath)] -> ![MappingIdentity] -> ![Text] -> ![Text] -> ![BindingHole] -> ![BehaviorRecordRow] -> ![Text] -> !Bool -> ![QueryContractIdentity] -> ![RouterSelectionSnapshot] -> !Maybe SemanticImpactSnapshot -> ScaffoldRecord
+ Keiro.Dsl.ScaffoldRecord: ScaffoldRecord :: !Text -> !Text -> !Text -> !SourceLanguage -> !EffectiveLanguageContract -> !GeneratedHaskellNamingEdition -> ![ScaffoldModuleRoleRow] -> ![(ModuleKind, FilePath)] -> ![MappingIdentity] -> ![Text] -> ![Text] -> ![BindingHole] -> ![BehaviorRecordRow] -> ![Text] -> !Bool -> ![QueryContractIdentity] -> ![RouterSelectionSnapshot] -> ![ProcessReactionRecordRow] -> !Maybe SemanticImpactSnapshot -> ScaffoldRecord
- Keiro.Dsl.ScaffoldRun: ScaffoldReport :: !FilePath -> !FilePath -> !Context -> ![(ScaffoldModule, WriteDisposition)] -> ![(Text, Text)] -> !FilePath -> !FilePath -> !Maybe Text -> ![StaleModule] -> !ConsumerPlan -> ![Text] -> ![MappingDrift] -> !Bool -> ![QueryContractDrift] -> ![QueryContractMigration] -> !SemanticImpactReport -> ![RouterSelectionDrift] -> !Maybe ProjectionMappedImpact -> ![GeneratedArtifactImpact] -> !Maybe SourceLanguageDrift -> ![BindingHole] -> ![BehaviorRecordRow] -> ![BehaviorRecordRow] -> ![(Text, Text)] -> !Maybe ConformancePackageReport -> ![SourceMove] -> ![SidecarMove] -> ScaffoldReport
+ Keiro.Dsl.ScaffoldRun: ScaffoldReport :: !FilePath -> !FilePath -> !Context -> ![(ScaffoldModule, WriteDisposition)] -> ![(Text, Text)] -> !FilePath -> !FilePath -> !Maybe Text -> ![StaleModule] -> !ConsumerPlan -> ![Text] -> ![MappingDrift] -> !Bool -> ![QueryContractDrift] -> ![QueryContractMigration] -> !SemanticImpactReport -> ![RouterSelectionDrift] -> ![ProcessReactionDrift] -> !Maybe ProjectionMappedImpact -> ![GeneratedArtifactImpact] -> !Maybe SourceLanguageDrift -> ![BindingHole] -> ![ProcessReactionRecordRow] -> ![BehaviorRecordRow] -> ![BehaviorRecordRow] -> ![(Text, Text)] -> !Maybe ConformancePackageReport -> ![SourceMove] -> ![SidecarMove] -> ScaffoldReport
- Keiro.Dsl.TypeGraph: RootCommandField :: !Name -> !Name -> !Name -> !MappedKey -> UseSite
+ Keiro.Dsl.TypeGraph: RootCommandField :: !Name -> !Name -> !Name -> RootRef
- Keiro.Dsl.TypeGraph: RootEventField :: !Name -> !Name -> !Name -> !MappedKey -> UseSite
+ Keiro.Dsl.TypeGraph: RootEventField :: !Name -> !Name -> !Name -> RootRef
- Keiro.Dsl.TypeGraph: RootReadModelQueryInput :: !Name -> !MappedKey -> UseSite
+ Keiro.Dsl.TypeGraph: RootReadModelQueryInput :: !Name -> RootRef
- Keiro.Dsl.TypeGraph: RootReadModelQueryResult :: !Name -> !MappedKey -> UseSite
+ Keiro.Dsl.TypeGraph: RootReadModelQueryResult :: !Name -> RootRef
- Keiro.Dsl.TypeGraph: RootRegister :: !Name -> !Name -> !MappedKey -> UseSite
+ Keiro.Dsl.TypeGraph: RootRegister :: !Name -> !Name -> RootRef
- Keiro.Dsl.TypeGraph: RootWorkqueueField :: !Name -> !Name -> !MappedKey -> UseSite
+ Keiro.Dsl.TypeGraph: RootWorkqueueField :: !Name -> !Name -> RootRef
- Keiro.Dsl.TypeGraph: TypeExprAlgebra :: a -> a -> a -> a -> a -> a -> a -> (a -> a) -> (a -> a) -> (a -> a) -> (MappedKey -> a) -> TypeExprAlgebra a
+ Keiro.Dsl.TypeGraph: TypeExprAlgebra :: a -> a -> a -> a -> a -> a -> a -> (a -> a) -> (a -> a) -> (a -> a) -> (NominalLeaf -> a -> a) -> (MappedKey -> a) -> (NominalLeaf -> a) -> TypeExprAlgebra a
- Keiro.Dsl.TypeGraph: TypeGraph :: !Map MappedKey ResolvedMappedDecl -> !Map MappedKey (Set MappedKey) -> ![UseSite] -> !Map UseSite [PathSeg] -> ![DerivedMappedConsumer] -> !Map DerivedMappedConsumer Name -> !Map DerivedMappedConsumer Text -> ![UnsupportedProjectionSource] -> TypeGraph
+ Keiro.Dsl.TypeGraph: TypeGraph :: !Map MappedKey ResolvedMappedDecl -> !Map MappedKey (Set MappedKey) -> !Map Name NominalLeaf -> !Map Name Text -> !Map MappedKey (Set Name) -> ![UseSite] -> ![NominalRootSite] -> !Map UseSite [PathSeg] -> ![DerivedMappedConsumer] -> !Map DerivedMappedConsumer Name -> !Map DerivedMappedConsumer Text -> ![UnsupportedProjectionSource] -> TypeGraph
- Keiro.Dsl.TypeGraph: UsePath :: !UseSite -> ![PathSeg] -> UsePath
+ Keiro.Dsl.TypeGraph: UsePath :: !RootRef -> ![PathSeg] -> UsePath
- Keiro.Dsl.TypeGraph: [root] :: UsePath -> !UseSite
+ Keiro.Dsl.TypeGraph: [root] :: UsePath -> !RootRef

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 view
@@ -6,6 +6,150 @@  ## [Unreleased] +## 0.17.0.0 — 2026-09-17++### Breaking Changes++- The public AST grows the Language 6 surface. `ProcessNode.input`, `.handle`,+  and `.timer` are replaced by `body :: ProcessBody`; `IntakeNode` gains+  `idempotence :: IdempotenceMode`; `WqOrdering` gains `WqFifoHeads`;+  `ContractType` gains `CDeclaredId`; and `TypeExpr` gains `TKeyedMap`. The+  reaction AST types are exported. No top-level exported type or function is+  removed or renamed, but exhaustive matches and positional construction must+  handle the new constructors and record shapes.+- `DiagnosticCode` gains 38 intake, reaction, timer, nominal-leaf, contract-ID,+  and default-value constructors. `LanguageFeature` gains+  `DelegatedInboxSyntax`, `ProcessReactionSyntax`, `ContractDeclaredIdSyntax`,+  and `KeyedMapSyntax`; `RuntimeCapability` gains `DelegatedInboxRuntime` and+  `StructuralNominalLeaves`.+- `DiffEnv` gains `oldService`, `newService`, and `newValidationErrors`;+  `ScaffoldReport` gains reaction coordination drift and ledger rows;+  `ScaffoldRecord` gains `processReactions`; and `Refusal` gains+  `HoleContractDrift`. `checkReport` and `workspaceCheckReport` now take a+  `CheckedService` rather than an `EffectiveLanguageContract`.+- `ordering fifo-heads` belongs to candidate Language 6. A Language 4 or 5+  source that used the token during the unreleased window must move to Language+  6 or choose a published legacy ordering with batch size one.+- Changing an intake between table and delegated idempotence is classified as+  `IntakeIdempotenceModeChanged` on the persisted-identity compatibility axis.+- Migrating a legacy process body to reactions is classified as+  `ProcessDispatchIdentityModelChanged`. Reaction target ids use physical target+  stream plus same-target occurrence instead of the legacy positional emit+  index, so the migration requires an explicit drain.+- Removing or changing the identity of a declared reaction timer is breaking+  while old rows may remain scheduled. A semantic reaction change without a+  `reactions version` increase, or a version decrease, is also breaking.++### New Features++- Candidate Language 6 adds `Map[DeclaredId] Value` to structural mappings.+  Generated shapes use the ID domain type as the Haskell key, codecs admit and+  render canonical TypeID object keys, consumer bindings declare a checked+  canonical-text ordering law, and coverage/diff/fold evidence records key+  position separately from map values.+- Candidate Language 6 contract event fields may name a declared `id` instead+  of repeating `typeid "prefix"`; generated and consumer-bound domain types+  retain the declaration's TypeID-v7 admission and compatibility identity.+- Aggregate expressions and declarative router selection may traverse required+  structural paths to nominal ID and enum leaves. Same-declaration equality is+  supported while nominal ordering, optional traversal, and cross-declaration+  comparisons remain rejected.+- Candidate Language 6 adds the `StructuralNominalLeaves` capability: generated+  and consumer-bound `id` and `enum` declarations plus `mapped nominal` scalars may appear+  inside structural records, unions, containers, typed workqueue fields, and+  read-model query input/results. Generated leaf codecs preserve the nominal+  Haskell type and apply Keiro-owned ID/scalar admission or the enum's exact+  declared wire spellings. Optional enum leaves accept constructor defaults for+  both generated and consumer-bound domain types.+- Candidate Language 6 workqueues accept `ordering fifo-heads`; round trips+  preserve the spelling, scaffolding emits `FifoHeads` and FIFO-index+  provisioning, and ordering diffs remain breaking delivery-contract changes.+- Candidate Language 6 adds `idempotence delegated` to intake declarations and+  generates a typed `runInboxIntake` wrapper over delegated runtime intake.+  Published Languages 1 through 5 and table-generated output remain unchanged.+- Candidate Language 6 adds first-class process reactions: multiple typed+  inputs, ordered input-only guards, optional saga advancement, explicit+  accepted-only follow-ups, timer-free processes, and multiple typed timers+  with rearm, once, cancellation, and generated firing behavior. Scaffolding+  emits the input ADT, pure reaction, `ReactiveProcessManager`, worker wrapper,+  timer payload codecs/builders, firing dispatcher, reaction version and+  fingerprint; only the typed source-event decoder remains a create-once Hole.++### Other Changes++- Candidate Language 6 reaction timers and fired events now derive UUIDv5 ids+  from length-prefixed UTF-8 prefix and correlation fields. Their semantic+  fingerprint uses a frozen canonical encoder that excludes operator-only+  timer retry policy. Published Languages 1 through 5 are unchanged.+- Reaction evolution reports now attach `drain-required` to guard, arm-order,+  fan-out, removal, and versioned-fingerprint advisories; timer removal,+  reaction-version decrease, and unversioned fingerprint changes classify on+  persisted identity. Harness ownership comes from the checked reaction result,+  and invalid reaction metadata returns a scaffold refusal instead of throwing.+- `keiro-dsl new <kind>` now writes the current published stable language even+  while a candidate language is registered.++- Direct `Optional DeclaredId` aggregate fields now point to the supported+  one-field `mapped structural` wrapper pattern, including the required+  `on-missing=null` policy.++- Coverage report schema 1 now appends `nominalBoundaries`, including+  nominal-only workqueue and query roots classified as structural rather than+  opaque.+- Nominal prefix, domain, representation, binding, fixture, and canonical-type+  diffs now carry every affected structural event, snapshot, workqueue,+  command, and query path with its surface-specific compatibility context.++- Aggregate transition diffs now partition live and replay-only transitions by+  source and command, then cancel byte-identical canonical transitions as a+  multiset before classifying guard changes. Identical and reordered sibling+  branches no longer emit false `AggGuardTightened` advisories, and no-emit+  branches are excluded from guard-history classification.+- Ambiguous emitting sibling remainders now produce the append-only+  `AggGuardRelationUnknown` advisory with explicit do-not-deploy guidance and+  no guessed replay-only edge. `diff --deny AggGuardRelationUnknown` promotes+  that advisory to a failing invocation when CI requires it.+- Computed replay-only twins omit Language-5 forward outcome clauses, so the+  printed remedy parses and validates under every released language.+- Guard evolution now compares the complete live guard union for each replay+  body after exact cancellation. Split and merged alternatives, duplicate+  removal, and cancelled covering siblings no longer produce false history+  advisories; removed emitting bodies receive the same mechanical remedy.+- Existing replay-only coverage must match the same replay body and is accepted+  when its guard is byte-canonically equal to the removed region, every old+  alternative implies the sibling alone, or every old alternative implies the+  union of the new live guards and the sibling. Shapes outside the deliberately+  small implication fragment remain conservative; stale or partial siblings do+  not hide a later hazard.+- The runtime-vocabulary test and structural-codec benchmark now bound their+  internal `keiro` and `shibuya-core` dependencies.+- Diff now inserts every proposed twin into a copied candidate and proves its+  effective-language render, parse, replay identity, cleared outcome, and+  validation before printing it. Failed proofs emit the append-only+  `AggGuardRemedyUnavailable` advisory with do-not-deploy guidance and no+  paste-ready transition. Explicit Hole-owned changes remain+  `AggGuardRelationUnknown`.+- Legacy processes gain a one-time `process-reaction` ledger row with+  `verification = "custom-unverified"`; the first re-scaffold reports this as+  informational coordination drift. Check-report schema+  `keiro-dsl/check-report/1` appends a `processReactions` key.+- Generated `QueuePolicy.hs` files now explain that deployment owns a positive+  batch size. This comment-only byte change applies to every language,+  including frozen Language 4, without changing generated behavior or fold+  identity.+- Fix the parser-scaling benchmark's access to the current scaffold `path` and+  `text` record fields.+- Reaction checking reports total input ownership, Boolean/input-only guards,+  explicit silence, acceptance evidence, typed mappings, timer payload+  completeness, timer identity, and worker-policy errors at their source lines.+  Diff and scaffold ledgers expose checked reaction fingerprints, versions,+  verification mode, arm/fan-out changes, timer evolution, and coordination+  drift without changing aggregate fold identity.+- Generated PostgreSQL conformance covers guarded and no-action delivery,+  accepted replay, partial fan-out recovery, typed silence, timer rearm/once/+  cancel/fire/terminal/race behavior, mutation resistance, bounded fan-out+  scaling, and opt-in hydration observations.+ ## 0.16.0.0 — 2026-09-07  ### Other Changes
app/Main.hs view
@@ -53,7 +53,7 @@   | Inspect FilePath InspectionFormat   | BehaviorObligations FilePath BehaviorFormat   | 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)+  | Diff FilePath String (Maybe FilePath) (Maybe FilePath) [CompatibilitySurface] Bool (Maybe FilePath) (Maybe DiffCoverageOptions) [DiagnosticCode]   | New String  data InspectionFormat = InspectionJson@@ -111,7 +111,7 @@           (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"))+          (info (Diff <$> fileArg <*> sinceOpt <*> optional emitGoldensOpt <*> optional replayImpactOutOpt <*> many gateOpt <*> explainSwitch <*> optional reportOutOpt <*> diffCoverageOptions <*> diffDenyCodesOptions <**> helper) (progDesc "Classify spec changes since a git ref as per-surface compatibility vectors; exit non-zero on any gated BREAKING surface"))         <> command           "new"           (info (New <$> kindArg <**> helper) (progDesc "Print a minimal valid .keiro skeleton for a node kind (aggregate, process, router, contract, intake, emit, publisher, workqueue, dispatch, workflow, operation)"))@@ -220,6 +220,31 @@           (long "deny" <> metavar "CODE[,CODE...]" <> help "Exit non-zero for warning diagnostics with these stable codes (repeatable)")       ) +diffDenyCodesOptions :: Parser [DiagnosticCode]+diffDenyCodesOptions =+  concat+    <$> many+      ( option+          (eitherReader parseDiffDenyCodes)+          (long "deny" <> metavar "CODE[,CODE...]" <> help "Exit non-zero for advisory diff findings with these stable codes (repeatable)")+      )++parseDiffDenyCodes :: String -> Either String [DiagnosticCode]+parseDiffDenyCodes raw = traverse parseOne (T.splitOn "," (T.pack raw))+  where+    parseOne token+      | T.null token = Left "--deny requires one or more comma-separated diagnostic codes"+      | otherwise = case parseDiagnosticCode token of+          Nothing -> Left ("unknown diagnostic code `" <> T.unpack token <> "`; copy the spelling exactly from WARNING output")+          Just diagnosticCode -> case diagnosticOrigin diagnosticCode of+            DiffDiagnostic -> Right diagnosticCode+            _ ->+              Left+                ( "diagnostic code `"+                    <> T.unpack token+                    <> "` is not emitted by the cross-revision diff finding pipeline"+                )+ -- | Parse a @--deny@ argument, refusing codes @check@ can never emit. -- -- A denial that can never match is worse than no denial: it reads like a gate in@@ -415,6 +440,23 @@         <> T.intercalate ", " [diagnosticCodeText diagnosticCode | diagnosticCode <- [minBound .. maxBound], diagnosticCode `elem` deniedCodes]         <> ")" +deniedDiffWarningCodes :: [DiagnosticCode] -> [Change] -> [DiagnosticCode]+deniedDiffWarningCodes selected changes =+  [ (.code) kind+  | Advisory kind <- changes,+    (.code) kind `elem` selected+  ]++emitDeniedDiffSummary :: [DiagnosticCode] -> IO ()+emitDeniedDiffSummary deniedCodes =+  when (not (null deniedCodes)) $+    TIO.hPutStrLn stderr $+      "diff: "+        <> T.pack (show (length deniedCodes))+        <> " advisory finding(s) escalated to failure (denied: "+        <> T.intercalate ", " [diagnosticCodeText diagnosticCode | diagnosticCode <- [minBound .. maxBound], diagnosticCode `elem` deniedCodes]+        <> ")"+ checkReportEnforcement :: CheckOptions -> CheckReport.CheckReportEnforcement checkReportEnforcement options =   CheckReport.CheckReportEnforcement@@ -442,7 +484,7 @@     ( CheckReport.checkReport         subject         ((.sourceLanguage) parsedSource)-        (checkedLanguageContract service)+        service         enforcement         diagnostics         (CheckReport.effectiveDenyCodes enforcement)@@ -457,7 +499,7 @@     ( CheckReport.workspaceCheckReport         subject         workspace-        (checkedLanguageContract service)+        service         enforcement         diagnostics         (CheckReport.effectiveDenyCodes enforcement)@@ -498,8 +540,8 @@   | isWorkspacePath fp = runWorkspaceBehaviorObligations fp format 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 (Diff fp ref emitGoldensRoot replayImpactOut gatedSurfaces explain reportOut coverageOptions denyCodes)+  | isWorkspacePath fp = runWorkspaceDiff fp ref emitGoldensRoot replayImpactOut gatedSurfaces explain reportOut coverageOptions denyCodes run (Parse fp) = do   input <- TIO.readFile fp   case parseSourceDocument fp input of@@ -605,7 +647,7 @@         else case sourceAwareBehaviorReport fp Nothing sourceIndex spec of           Left failure -> renderBehaviorReportFailure failure           Right report -> writeBehaviorReport format report-run (Diff fp ref emitGoldensRoot replayImpactOut gatedSurfaces explain reportOut coverageOptions) = do+run (Diff fp ref emitGoldensRoot replayImpactOut gatedSurfaces explain reportOut coverageOptions denyCodes) = do   -- Resolve the spec to a repo-relative path so `git show <ref>:<relpath>` works.   let dir = takeDirectory fp   rootRes <- git dir ["rev-parse", "--show-toplevel"]@@ -648,7 +690,9 @@                     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) . (.severity)) coordination || not coverageOk then exitFailure else pure ()+                    let deniedWarningCodes = deniedDiffWarningCodes denyCodes changes+                    emitDeniedDiffSummary deniedWarningCodes+                    if any (gatedBreaking effectiveGate) changes || any ((== CoordinationBreaking) . (.severity)) coordination || not coverageOk || not (null deniedWarningCodes) 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).@@ -909,8 +953,9 @@   Bool ->   Maybe FilePath ->   Maybe DiffCoverageOptions ->+  [DiagnosticCode] ->   IO ()-runWorkspaceDiff fp ref emitGoldensRoot replayImpactOut gatedSurfaces explain reportOut coverageOptions = do+runWorkspaceDiff fp ref emitGoldensRoot replayImpactOut gatedSurfaces explain reportOut coverageOptions denyCodes = do   let dir = takeDirectory fp   rootRes <- git dir ["rev-parse", "--show-toplevel"]   case rootRes of@@ -990,7 +1035,9 @@                           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) . (.severity)) coordination || not coverageOk then exitFailure else pure ()+                          let deniedWarningCodes = deniedDiffWarningCodes denyCodes changes+                          emitDeniedDiffSummary deniedWarningCodes+                          if any (gatedBreaking effectiveGate) changes || any ((== CoordinationBreaking) . (.severity)) coordination || not coverageOk || not (null deniedWarningCodes) then exitFailure else pure ()  -- | A @git show@ backed source rooted at a workspace manifest directory. gitContentSource :: FilePath -> String -> FilePath -> ContentSource
bench/parser-scaling/Main.hs view
@@ -11,7 +11,7 @@ import Keiro.Dsl.Grammar (Node (..), Spec (..)) import Keiro.Dsl.LanguageVersion (ParsedSource (..)) import Keiro.Dsl.Parser (parseSource, renderParseFailure)-import Keiro.Dsl.Scaffold (ScaffoldModule, defaultContext, firewallBreaches, modulePath, moduleText, scaffoldAggregateForService)+import Keiro.Dsl.Scaffold (ScaffoldModule (..), defaultContext, firewallBreaches, scaffoldAggregateForService) import Keiro.Dsl.ScaffoldRun (scaffoldServiceModules) import Keiro.Dsl.SemanticContract (checkedSource) import Keiro.Dsl.Syntax (SurfaceSource)@@ -100,8 +100,8 @@     let modules = generateOutcomeModulesOrFail fixture         eventStream = outcomeEventStreamOrFail modules         armCount = T.count " -> SilentRejected" eventStream + T.count " -> SilentNoOp" eventStream-    _ <- evaluate (sum (map (T.length . moduleText) modules))-    unless (armCount == fixtureSilentEdgeCount fixture) $+    _ <- evaluate (sum (map (T.length . (.text)) modules))+    unless (armCount == (.fixtureSilentEdgeCount) fixture) $       error ("outcome classifier arm count mismatch for " <> outcomeLabel fixture)     unless (firewallBreaches modules == []) $       error ("outcome fixture breached generated symbolic firewall for " <> outcomeLabel fixture)@@ -323,32 +323,32 @@  checkOutcomeOrFail :: OutcomeFixture -> Int checkOutcomeOrFail fixture =-  case parseSource (outcomePath fixture) (fixtureOutcomeSource fixture) of+  case parseSource (outcomePath fixture) ((.fixtureOutcomeSource) fixture) of     Left failure -> error (T.unpack (renderParseFailure failure))     Right parsed -> case validateService (checkedSource parsed) of-      [] -> fixtureSilentEdgeCount fixture+      [] -> (.fixtureSilentEdgeCount) fixture       diagnostics -> error ("outcome benchmark validation failed: " <> show diagnostics)  generateOutcomeBytesOrFail :: OutcomeFixture -> Int-generateOutcomeBytesOrFail = sum . map (T.length . moduleText) . generateOutcomeModulesOrFail+generateOutcomeBytesOrFail = sum . map (T.length . (.text)) . generateOutcomeModulesOrFail  generateOutcomeModulesOrFail :: OutcomeFixture -> [ScaffoldModule] generateOutcomeModulesOrFail fixture =-  case parseSource (outcomePath fixture) (fixtureOutcomeSource fixture) of+  case parseSource (outcomePath fixture) ((.fixtureOutcomeSource) fixture) of     Left failure -> error (T.unpack (renderParseFailure failure))-    Right parsed -> case [aggregate | NAggregate aggregate <- specNodes (parsedSpec parsed)] of+    Right parsed -> case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) parsed)] of       [aggregate] ->         scaffoldAggregateForService-          (defaultContext (specContext (parsedSpec parsed)))+          (defaultContext ((.context) ((.spec) parsed)))           (checkedSource parsed)           aggregate       aggregates -> error ("outcome benchmark expected one aggregate, got " <> show (length aggregates))  outcomeEventStreamOrFail :: [ScaffoldModule] -> Text outcomeEventStreamOrFail modules =-  case [ moduleText scaffoldModule+  case [ (.text) scaffoldModule        | scaffoldModule <- modules,-         "/EventStream.hs" `T.isSuffixOf` T.pack (modulePath scaffoldModule)+         "/EventStream.hs" `T.isSuffixOf` T.pack ((.path) scaffoldModule)        ] of     [eventStream] -> eventStream     eventStreams -> error ("outcome benchmark expected one event-stream module, got " <> show (length eventStreams))@@ -371,17 +371,17 @@ checkTypeGraphOrFail :: TypeGraphFixture -> Int checkTypeGraphOrFail fixture@TypeGraphFixture {fixtureTypeGraphParsed} =   case validateService (checkedSource fixtureTypeGraphParsed) of-    [] -> fixtureMappedCount fixture + fixtureRouterCount fixture+    [] -> (.fixtureMappedCount) fixture + (.fixtureRouterCount) fixture     diagnostics -> error ("type-graph benchmark validation failed: " <> show diagnostics)  scaffoldTypeGraphBytes :: TypeGraphFixture -> Int scaffoldTypeGraphBytes TypeGraphFixture {fixtureTypeGraphParsed} =-  let spec = parsedSpec fixtureTypeGraphParsed+  let spec = (.spec) fixtureTypeGraphParsed       service = checkedSource fixtureTypeGraphParsed    in sum         ( map-            (T.length . moduleText)-            (scaffoldServiceModules (defaultContext (specContext spec)) service)+            (T.length . (.text))+            (scaffoldServiceModules (defaultContext ((.context) spec)) service)         )  typeGraphSpecification :: Int -> Int -> Text
+ bench/process-scaling/Main.hs view
@@ -0,0 +1,118 @@+module Main (main) where++import Control.Exception (evaluate)+import Control.Monad (forM_, unless)+import Data.Text (Text)+import Data.Text qualified as Text+import Keiro.Dsl.Grammar (Spec (..))+import Keiro.Dsl.LanguageVersion (ParsedSource (..))+import Keiro.Dsl.Parser (parseSource, renderParseFailure)+import Keiro.Dsl.Scaffold (ScaffoldModule (..), defaultContext)+import Keiro.Dsl.ScaffoldRun (scaffoldServiceModules)+import Keiro.Dsl.SemanticContract (checkedSource)+import Keiro.Dsl.Validate (validateService)+import Test.Tasty.Bench (Benchmark, bench, defaultMain, whnf)++data Fixture = Fixture+  { dispatchCount :: !Int,+    parsedSource :: !ParsedSource,+    generatedBytes :: !Int+  }++main :: IO ()+main = do+  let fixtures = map fixture [8, 32, 128]+  forM_ fixtures $ \entry -> do+    _ <- evaluate entry.generatedBytes+    putStrLn+      ( "process-scaling dispatches="+          <> show entry.dispatchCount+          <> " generated-bytes="+          <> show entry.generatedBytes+      )+  forM_ (zip fixtures (drop 1 fixtures)) $ \(smaller, larger) ->+    unless (smaller.generatedBytes < larger.generatedBytes) $+      error "process-reaction generated bytes did not grow with dispatch count"+  defaultMain (map benchmark fixtures)++fixture :: Int -> Fixture+fixture count =+  let parsed = parseOrFail count (specification count)+      diagnostics = validateService (checkedSource parsed)+      bytes = scaffoldBytes parsed+   in if null diagnostics+        then Fixture count parsed bytes+        else error ("process-scaling validation failed: " <> show diagnostics)++benchmark :: Fixture -> Benchmark+benchmark entry =+  bench+    ( "dispatches-"+        <> show entry.dispatchCount+        <> "-bytes-"+        <> show entry.generatedBytes+    )+    (whnf scaffoldBytes entry.parsedSource)++parseOrFail :: Int -> Text -> ParsedSource+parseOrFail count source =+  case parseSource ("process-scaling-" <> show count <> ".keiro") source of+    Left failure -> error (Text.unpack (renderParseFailure failure))+    Right parsed -> parsed++scaffoldBytes :: ParsedSource -> Int+scaffoldBytes parsed =+  sum+    ( map+        (Text.length . (.text))+        ( scaffoldServiceModules+            (defaultContext parsed.spec.context)+            (checkedSource parsed)+        )+    )++specification :: Int -> Text+specification count =+  Text.unlines+    [ "language keiro-dsl 6",+      "context process-scaling",+      "",+      "id ThingId prefix=thing",+      "",+      "process FanOut",+      "  name \"fan-out\"",+      "  reactions version 1",+      "  input Triggered { thingId:ThingId }",+      "  correlate input.thingId via idText",+      "  saga Coordinator category \"coordinator\"",+      "  target Target",+      "  projections [ ]",+      "  on Triggered",+      "    advance Record { thingId }"+    ]+    <> Text.concat (replicate count dispatch)+    <> Text.unlines+      [ "  dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, targetStreamName, occurrence)",+        "  rejected => halt",+        "  poison => halt",+        "",+        "aggregate Coordinator",+        "  regs",+        "  states Open",+        "  command Record { thingId }",+        "  event Recorded = fields(Record)",+        "  Open -- Record --> emit Recorded ; goto Open",+        "",+        "aggregate Target",+        "  regs",+        "  states Open",+        "  command Touch { thingId }",+        "  event Touched = fields(Touch)",+        "  Open -- Touch --> emit Touched ; goto Open"+      ]+  where+    dispatch =+      Text.unlines+        [ "    dispatch Target@input.thingId Touch { thingId }",+          "      on-appended AckOk ; on-duplicate AckOk ; on-failed Retry"+        ]
generated-haskell-edition-idiomatic-v2.md view

file too large to diff

keiro-dsl.cabal view
@@ -1,1485 +1,1797 @@-cabal-version:      3.0-name:               keiro-dsl-version:            0.16.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-  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--common shared-  default-language:   GHC2024-  default-extensions:-    DuplicateRecordFields-    ImportQualifiedPost-    LambdaCase-    NoFieldSelectors-    OverloadedLabels-    OverloadedRecordDot-    OverloadedStrings---- Every component importing this stanza compiles only `keiro-dsl scaffold`--- output plus hand-filled holes. Generated code is regenerated wholesale, so a--- warning in it is a generator defect with nothing for a human to fix in place:--- -Werror keeps such a regression from building green. This is deliberately not--- added to `warnings`, where src/ keeps -Wall non-fatal. Hackage rejects an--- unconditional -Werror, so the gate rides a manual flag that this repository's--- cabal.project switches on; the published sdist defaults it off.-flag werror-generated-  description:-    Promote warnings in committed generated conformance output to errors--  manual:      True-  default:     False--common generated-output-  default-language:   GHC2024-  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-  -- user-maintained and cannot act on Keiro's Haskell API deprecations, so keep-  -- them compilable under the generated-output -Werror gate. Candidate Language-  -- 5 emits the truthful API and does not rely on this compatibility allowance.-  ghc-options:        -Wno-deprecations--  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-  autogen-modules: Paths_keiro_dsl-  exposed-modules:-    Keiro.Dsl.AggregateType-    Keiro.Dsl.BehaviorCoverage-    Keiro.Dsl.BehaviorSourceMap-    Keiro.Dsl.CanonicalEncoding-    Keiro.Dsl.CheckReport-    Keiro.Dsl.CodecCompare-    Keiro.Dsl.ConformancePackage-    Keiro.Dsl.ConsumerTypePlan-    Keiro.Dsl.CoordinationImpact-    Keiro.Dsl.Coverage-    Keiro.Dsl.Diff-    Keiro.Dsl.DiffReport-    Keiro.Dsl.EventOutput-    Keiro.Dsl.ExplainBindings-    Keiro.Dsl.Expression-    Keiro.Dsl.FoldFingerprint-    Keiro.Dsl.Frontend-    Keiro.Dsl.Goldens-    Keiro.Dsl.Grammar-    Keiro.Dsl.Harness-    Keiro.Dsl.HaskellImport-    Keiro.Dsl.HaskellSourceMove-    Keiro.Dsl.IdDomain-    Keiro.Dsl.LanguageVersion-    Keiro.Dsl.Manifest-    Keiro.Dsl.MappedCodecPlan-    Keiro.Dsl.MappedConsumer-    Keiro.Dsl.MappedDiff-    Keiro.Dsl.NominalType-    Keiro.Dsl.Parser-    Keiro.Dsl.PrettyPrint-    Keiro.Dsl.ProjectionMappedImpact-    Keiro.Dsl.ProjectionSupply-    Keiro.Dsl.ReadModelQueryContract-    Keiro.Dsl.ReadModelShape-    Keiro.Dsl.ReplayImpact-    Keiro.Dsl.RouterSelection-    Keiro.Dsl.RuntimePackage-    Keiro.Dsl.Scaffold-    Keiro.Dsl.ScaffoldRecord-    Keiro.Dsl.ScaffoldRun-    Keiro.Dsl.SemanticContract-    Keiro.Dsl.SemanticImpact-    Keiro.Dsl.ServiceHarness-    Keiro.Dsl.SidecarMigration-    Keiro.Dsl.SidecarNames-    Keiro.Dsl.Skeleton-    Keiro.Dsl.Source-    Keiro.Dsl.SourceIndex-    Keiro.Dsl.StructuralConformance-    Keiro.Dsl.Syntax-    Keiro.Dsl.TypeGraph-    Keiro.Dsl.Validate-    Keiro.Dsl.Workspace-    Keiro.Dsl.WorkspaceAdoption-    Keiro.Dsl.WorkspaceDiff-    Keiro.Dsl.WorkspaceRecord-    Keiro.Dsl.WorkspaceScaffold--  other-modules:-    Keiro.Dsl.AggregateGenerationPlan-    Keiro.Dsl.FieldIdentity-    Keiro.Dsl.Frontend.Internal-    Keiro.Dsl.HaskellName-    Keiro.Dsl.Parser.Aggregate-    Keiro.Dsl.Parser.Coordination-    Keiro.Dsl.Parser.Core-    Keiro.Dsl.Parser.Declaration-    Keiro.Dsl.Parser.Document-    Keiro.Dsl.Parser.Expression-    Keiro.Dsl.Parser.Integration-    Keiro.Dsl.Parser.Mapped-    Keiro.Dsl.Parser.Preamble-    Keiro.Dsl.Parser.ProjectionCatalog-    Keiro.Dsl.Parser.Queue-    Keiro.Dsl.Parser.ReadModel-    Keiro.Dsl.Parser.Workflow-    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.16.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-  hs-source-dirs: app-  main-is:        Main.hs-  build-depends:-    , aeson                 >=2.2  && <2.3-    , base                  >=4.21 && <5-    , directory             >=1.3  && <1.4-    , filepath              >=1.4  && <1.6-    , keiro-dsl-    , optparse-applicative  >=0.18 && <0.20-    , process               >=1.6  && <1.7-    , text                  >=2.1  && <2.2--test-suite keiro-dsl-test-  import:             warnings, shared-  type:               exitcode-stdio-1.0-  hs-source-dirs:     test-  main-is:            Main.hs-  build-tool-depends: keiro-dsl:keiro-dsl-  autogen-modules:    Paths_keiro_dsl-  other-modules:-    Keiro.Dsl.ConformanceBaseline-    Keiro.Dsl.FrontendCompatibility-    Keiro.Dsl.FrontendProfiles-    Keiro.Dsl.FrontendPublicApiProbe-    Keiro.Dsl.FrontendSurface-    Paths_keiro_dsl--  build-depends:-    , 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.16.0.0-    , keiro-dsl-    , 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-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/import-planning src-  main-is:        Main.hs-  other-modules:-    Keiro.Dsl.HaskellImport-    Keiro.Dsl.HaskellName--  build-depends:-    , base        >=4.21 && <5-    , containers  >=0.6  && <0.8-    , hspec       >=2.11-    , text        >=2.1  && <2.2--test-suite keiro-dsl-haskell-name-test-  import:         warnings, shared-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/haskell-name src-  main-is:        Main.hs-  other-modules:  Keiro.Dsl.HaskellName-  build-depends:-    , base        >=4.21 && <5-    , containers  >=0.6  && <0.8-    , hspec       >=2.11-    , QuickCheck  >=2.14-    , text        >=2.1  && <2.2---- Plan 199: keiro-dsl validates specs without depending on the keiro runtime--- package, so a few runtime vocabularies are restated in Keiro.Dsl.Validate.--- This suite depends on both packages and fails when a restatement drifts from--- the definition it mirrors.-test-suite keiro-dsl-runtime-vocabulary-test-  import:         warnings, shared-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/runtime-vocabulary-  main-is:        Main.hs-  build-depends:-    , base          >=4.21 && <5-    , keiro-    , keiro-dsl-    , shibuya-core-    , text          >=2.1  && <2.2---- Conformance: proves the scaffolded Generated modules plus a hand-filled--- Holes.hs compile against keiki/keiro and that the filled transducer passes--- keiki's validator and the codec round-trips. The Generated.* modules under--- test/conformance/ are byte-identical to `keiro-dsl scaffold` output (pinned--- by the scaffold-conformance test in keiro-dsl-test).-test-suite keiro-dsl-conformance-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.BehaviorSourceMap-    Generated.HospitalCapacity.Nominals-    Generated.HospitalCapacity.Nominals.Internal-    Generated.HospitalCapacity.ReplayAudit-    Generated.HospitalCapacity.Reservation.Codec-    Generated.HospitalCapacity.Reservation.Domain-    Generated.HospitalCapacity.Reservation.EventStream-    Generated.HospitalCapacity.Reservation.Harness-    Generated.HospitalCapacity.Reservation.Projection-    Generated.HospitalCapacity.Reservation.Transducer-    HospitalCapacity.Reservation.Holes--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , bytestring  >=0.12 && <0.13-    , keiki       >=0.9  && <0.10-    , keiro-    , text        >=2.1  && <2.2---- Plan 157: compiled direct Time/Natural aggregate fields and registers,--- symbolic equality/ordering, codecs, snapshots, forward/replay equality,--- Natural JSON boundaries, canonical identity, and opaque arithmetic audit.-test-suite keiro-dsl-conformance-aggregate-scalars-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-aggregate-scalars-  main-is:        Main.hs-  other-modules:-    AggregateScalars.ScalarLedger.Holes-    Generated.AggregateScalars.BehaviorSourceMap-    Generated.AggregateScalars.ReplayAudit-    Generated.AggregateScalars.ScalarLedger.Codec-    Generated.AggregateScalars.ScalarLedger.Domain-    Generated.AggregateScalars.ScalarLedger.EventStream-    Generated.AggregateScalars.ScalarLedger.Harness-    Generated.AggregateScalars.ScalarLedger.Projection-    Generated.AggregateScalars.ScalarLedger.Transducer--  build-depends:-    , aeson  >=2.2  && <2.3-    , base   >=4.21 && <5-    , keiki  >=0.9  && <0.10-    , keiro-    , text   >=2.1  && <2.2-    , time   >=1.12 && <1.15---- Plan 161: compiled authoritative version-2 scalar expressions, generated--- transition ownership, explicit Hole opacity/fold identity, and concrete,--- symbolic, codec-replay, and snapshot-invalidation agreement.-test-suite keiro-dsl-conformance-aggregate-scalar-expressions-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-scalar-expressions-  main-is:        Main.hs-  other-modules:-    AggregateScalarExpressions.ScalarAccount.BehaviorHoles-    AggregateScalarExpressions.ScalarAccount.Holes-    Generated.AggregateScalarExpressions.BehaviorSourceMap-    Generated.AggregateScalarExpressions.Nominals-    Generated.AggregateScalarExpressions.Nominals.Internal-    Generated.AggregateScalarExpressions.ReplayAudit-    Generated.AggregateScalarExpressions.ScalarAccount.BehaviorContract-    Generated.AggregateScalarExpressions.ScalarAccount.Codec-    Generated.AggregateScalarExpressions.ScalarAccount.Domain-    Generated.AggregateScalarExpressions.ScalarAccount.EventStream-    Generated.AggregateScalarExpressions.ScalarAccount.Harness-    Generated.AggregateScalarExpressions.ScalarAccount.Projection-    Generated.AggregateScalarExpressions.ScalarAccount.Transducer-    Generated.AggregateScalarExpressions.Structural.Shape.Limits-    Generated.AggregateScalarExpressions.StructuralConformance-    Generated.AggregateScalarExpressions.StructuralProjections-    ScalarExpressions.Bindings-    ScalarExpressions.Domain--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , containers  >=0.6  && <0.8-    , keiki       >=0.9  && <0.10-    , keiro-    , keiro-dsl-    , text        >=2.1  && <2.2-    , time        >=1.12 && <1.15--test-suite keiro-dsl-conformance-behavior-complete-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-behavior-complete-  main-is:        Main.hs-  other-modules:-    BehaviorComplete.Bindings-    BehaviorComplete.Domain-    BehaviorComplete.Journey.BehaviorHoles-    BehaviorComplete.Journey.Holes-    Generated.BehaviorComplete.BehaviorSourceMap-    Generated.BehaviorComplete.Journey.BehaviorContract-    Generated.BehaviorComplete.Journey.Codec-    Generated.BehaviorComplete.Journey.Domain-    Generated.BehaviorComplete.Journey.EventStream-    Generated.BehaviorComplete.Journey.Harness-    Generated.BehaviorComplete.Journey.Projection-    Generated.BehaviorComplete.Journey.Transducer-    Generated.BehaviorComplete.Nominals-    Generated.BehaviorComplete.Nominals.Internal-    Generated.BehaviorComplete.ReplayAudit-    Generated.BehaviorComplete.Structural.Shape.StartPayload-    Generated.BehaviorComplete.StructuralConformance-    Generated.BehaviorComplete.StructuralProjections--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , bytestring  >=0.12 && <0.13-    , containers  >=0.6  && <0.8-    , keiki       >=0.9  && <0.10-    , keiro-    , text        >=2.1  && <2.2-    , time        >=1.12 && <1.15--test-suite keiro-dsl-conformance-domain-outcomes-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-domain-outcomes-  main-is:        Main.hs-  other-modules:-    DomainOutcomes.Reservation.BehaviorHoles-    Generated.DomainOutcomes.BehaviorSourceMap-    Generated.DomainOutcomes.Nominals-    Generated.DomainOutcomes.ReplayAudit-    Generated.DomainOutcomes.Reservation.BehaviorContract-    Generated.DomainOutcomes.Reservation.Codec-    Generated.DomainOutcomes.Reservation.Domain-    Generated.DomainOutcomes.Reservation.EventStream-    Generated.DomainOutcomes.Reservation.Harness-    Generated.DomainOutcomes.Reservation.Projection-    Generated.DomainOutcomes.Reservation.Transducer--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , containers  >=0.6  && <0.8-    , keiki       >=0.9  && <0.10-    , keiro-    , text        >=2.1  && <2.2---- EP-158: consumer-owned direct IDs, enums, and nominal scalar wrappers,--- checked KindID decoding, total bindings, projections, and snapshot caches.-test-suite keiro-dsl-conformance-nominal-scalars-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-nominal-scalars-  main-is:        Main.hs-  other-modules:-    Generated.NominalScalars.BehaviorSourceMap-    Generated.NominalScalars.Nominal.Shape.OrderStatus-    Generated.NominalScalars.NominalLedger.BehaviorContract-    Generated.NominalScalars.NominalLedger.Codec-    Generated.NominalScalars.NominalLedger.Domain-    Generated.NominalScalars.NominalLedger.EventStream-    Generated.NominalScalars.NominalLedger.Harness-    Generated.NominalScalars.NominalLedger.Projection-    Generated.NominalScalars.NominalLedger.Transducer-    Generated.NominalScalars.NominalProjections-    Generated.NominalScalars.ReplayAudit-    NominalConformance.Bindings-    NominalConformance.Domain-    NominalScalars.NominalLedger.BehaviorHoles--  build-depends:-    , aeson        >=2.2  && <2.3-    , base         >=4.21 && <5-    , containers   >=0.6  && <0.8-    , keiki        >=0.9  && <0.10-    , keiro-    , mmzk-typeid  >=0.7  && <0.8-    , text         >=2.1  && <2.2-    , time         >=1.12 && <1.15---- EP-168 / IR-2: one workspace-level generated ID/enum authority is imported--- by two aggregate rings. The driver passes values between both domain modules--- and round-trips both generated event codecs, so duplicate nominal types fail--- at compile time rather than escaping a path-only scaffold assertion.-test-suite keiro-dsl-conformance-workspace-nominals-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-workspace-nominals-  main-is:        Main.hs-  other-modules:-    Generated.WorkspaceNominalProof.BehaviorSourceMap-    Generated.WorkspaceNominalProof.Nominals-    Generated.WorkspaceNominalProof.Nominals.Internal-    Generated.WorkspaceNominalProof.Project.BehaviorContract-    Generated.WorkspaceNominalProof.Project.Codec-    Generated.WorkspaceNominalProof.Project.Domain-    Generated.WorkspaceNominalProof.Project.EventStream-    Generated.WorkspaceNominalProof.Project.Harness-    Generated.WorkspaceNominalProof.Project.Projection-    Generated.WorkspaceNominalProof.Project.Transducer-    Generated.WorkspaceNominalProof.ProjectArtifact.BehaviorContract-    Generated.WorkspaceNominalProof.ProjectArtifact.Codec-    Generated.WorkspaceNominalProof.ProjectArtifact.Domain-    Generated.WorkspaceNominalProof.ProjectArtifact.EventStream-    Generated.WorkspaceNominalProof.ProjectArtifact.Harness-    Generated.WorkspaceNominalProof.ProjectArtifact.Projection-    Generated.WorkspaceNominalProof.ProjectArtifact.Transducer-    Generated.WorkspaceNominalProof.ReplayAudit-    WorkspaceNominalProof.Project.BehaviorHoles-    WorkspaceNominalProof.ProjectArtifact.BehaviorHoles--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , containers  >=0.6  && <0.8-    , keiki       >=0.9  && <0.10-    , keiro-    , text        >=2.1  && <2.2---- Plan 150 / IR-1: compiled structural consumer bindings, declared-wire--- codecs, generated projection witnesses, opaque boundaries, fixture branch--- coverage, current payload goldens, and mapped-register replay equality.-test-suite keiro-dsl-conformance-structural-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-structural-  main-is:        Main.hs-  other-modules:-    Conformance.Structural.Bindings-    Conformance.Structural.Domain-    Generated.StructuralConformance.ArtifactCatalog.BehaviorContract-    Generated.StructuralConformance.ArtifactCatalog.Codec-    Generated.StructuralConformance.ArtifactCatalog.Domain-    Generated.StructuralConformance.ArtifactCatalog.EventStream-    Generated.StructuralConformance.ArtifactCatalog.Harness-    Generated.StructuralConformance.ArtifactCatalog.Projection-    Generated.StructuralConformance.ArtifactCatalog.Transducer-    Generated.StructuralConformance.BehaviorSourceMap-    Generated.StructuralConformance.ReplayAudit-    Generated.StructuralConformance.Structural.Shape.ArtifactInfo-    Generated.StructuralConformance.Structural.Shape.ArtifactKind-    Generated.StructuralConformance.Structural.Shape.ArtifactLocation-    Generated.StructuralConformance.Structural.Shape.ArtifactMetadata-    Generated.StructuralConformance.StructuralConformance-    Generated.StructuralConformance.StructuralProjections-    StructuralConformance.ArtifactCatalog.Holes--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , bytestring  >=0.12 && <0.13-    , containers  >=0.6  && <0.8-    , deepseq     >=1.5  && <1.6-    , keiki       >=0.9  && <0.10-    , keiro-    , text        >=2.1  && <2.2-    , time        >=1.12 && <1.15---- Plan 224: candidate language-5 mapped workqueue payloads share structural--- codec authority while preserving the queue schema-version-1 envelope.-test-suite keiro-dsl-conformance-mapped-queue-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-mapped-queue-  main-is:        Main.hs-  other-modules:-    Conformance.MappedQueue.Bindings-    Conformance.MappedQueue.Domain-    Generated.MappedQueue.MappedJobs.Queue-    Generated.MappedQueue.MappedJobs.QueueCodec-    Generated.MappedQueue.MappedJobs.QueuePolicy-    Generated.MappedQueue.Structural.Shape.JobMetadata-    Generated.MappedQueue.Structural.Shape.JobPayload-    Generated.MappedQueue.StructuralConformance-    Generated.MappedQueue.StructuralProjections--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , keiki       >=0.9  && <0.10-    , keiro-    , keiro-core-    , keiro-dsl-    , keiro-pgmq-    , text        >=2.1  && <2.2---- Plan 225: candidate language-5 read-model input/result expressions lower to--- generated mapped domain aliases while SQL and query bodies remain hand-owned.-test-suite keiro-dsl-conformance-mapped-readmodel-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-mapped-readmodel-  main-is:        Main.hs-  other-modules:-    Conformance.MappedReadModel.Bindings-    Conformance.MappedReadModel.Domain-    Generated.MappedReadmodel.AccountSummary.QueryContract-    Generated.MappedReadmodel.AccountSummary.ReadModel-    Generated.MappedReadmodel.AccountSummary.ReadModelHarness-    Generated.MappedReadmodel.AccountSummary.ReadModelTable-    Generated.MappedReadmodel.ProjectionCatalog-    Generated.MappedReadmodel.Structural.Shape.AccountLookup-    Generated.MappedReadmodel.Structural.Shape.AccountProfile-    Generated.MappedReadmodel.Structural.Shape.AccountSummary-    Generated.MappedReadmodel.Structural.Shape.TenantKey-    Generated.MappedReadmodel.Structural.Shape.UnusedFilter-    Generated.MappedReadmodel.StructuralConformance-    Generated.MappedReadmodel.StructuralProjections-    MappedReadmodel.AccountSummary.ReadModelHoles-    MappedReadmodel.ProjectionCatalog.ProjectionCatalogHoles--  build-depends:-    , base               >=4.21 && <5-    , effectful-core-    , hasql-transaction-    , keiki              >=0.9  && <0.10-    , keiro-    , keiro-dsl-    , kiroku-store-    , text               >=2.1  && <2.2---- Plan 184: colliding consumer type occurrences, local-name conflicts, and--- repeated binding/shape references compile with deterministic short aliases.-test-suite keiro-dsl-conformance-import-planning-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-import-planning-  main-is:        Main.hs-  other-modules:-    Generated.ImportPlanningCollisions.BehaviorSourceMap-    Generated.ImportPlanningCollisions.CollisionLedger.BehaviorContract-    Generated.ImportPlanningCollisions.CollisionLedger.Codec-    Generated.ImportPlanningCollisions.CollisionLedger.Domain-    Generated.ImportPlanningCollisions.CollisionLedger.EventStream-    Generated.ImportPlanningCollisions.CollisionLedger.Harness-    Generated.ImportPlanningCollisions.CollisionLedger.Projection-    Generated.ImportPlanningCollisions.CollisionLedger.Transducer-    Generated.ImportPlanningCollisions.NominalProjections-    Generated.ImportPlanningCollisions.ReplayAudit-    Generated.ImportPlanningCollisions.Structural.Shape.Details-    Generated.ImportPlanningCollisions.StructuralConformance-    Generated.ImportPlanningCollisions.StructuralProjections-    ImportPlanning.Bindings-    ImportPlanning.Consumer.Domain-    ImportPlanning.Consumer.Invoice.Types-    ImportPlanning.Consumer.Order.Types-    ImportPlanning.Consumer.Shared.Types-    ImportPlanningCollisions.CollisionLedger.BehaviorHoles--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , bytestring  >=0.12 && <0.13-    , containers  >=0.6  && <0.8-    , keiki       >=0.9  && <0.10-    , keiro-    , text        >=2.1  && <2.2-    , time        >=1.12 && <1.15---- Plan 152 / Experiment B: a consumer-owned historical codec and finite JSON--- corpus compared with the generated structural codec. The comparison module--- is opt-in tooling output and is not part of the production scaffold record.-test-suite keiro-dsl-conformance-codec-compare-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs:-    test/conformance-codec-compare test/conformance-structural--  main-is:        Main.hs-  other-modules:-    Conformance.CodecCompare.Historical-    Conformance.Structural.Bindings-    Conformance.Structural.Domain-    Generated.StructuralConformance.ArtifactCatalog.Codec-    Generated.StructuralConformance.ArtifactCatalog.Domain-    Generated.StructuralConformance.Structural.CodecCompare.ArtifactInfo-    Generated.StructuralConformance.Structural.Shape.ArtifactInfo-    Generated.StructuralConformance.Structural.Shape.ArtifactKind-    Generated.StructuralConformance.Structural.Shape.ArtifactLocation-    Generated.StructuralConformance.Structural.Shape.ArtifactMetadata--  build-depends:-    , aeson       >=2.2.1 && <2.3-    , base        >=4.21  && <5-    , containers  >=0.6   && <0.8-    , deepseq     >=1.5   && <1.6-    , directory   >=1.3   && <1.4-    , filepath    >=1.4   && <1.6-    , keiki       >=0.9   && <0.10-    , keiro-    , keiro-dsl-    , text        >=2.1   && <2.2---- Plan 147 M2: a dedicated honest-wire baseline plus a dormant idempotent--- dishonest WireCtor used by replay-mutation-test.sh to prove that generated--- forward/replay register comparisons catch state divergence missed by the--- pre-existing validator, codec round-trip, and accept assertions.-test-suite keiro-dsl-conformance-replay-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-replay-  main-is:        Main.hs-  other-modules:-    Generated.ReplayDivergence.BehaviorSourceMap-    Generated.ReplayDivergence.Note.Codec-    Generated.ReplayDivergence.Note.Domain-    Generated.ReplayDivergence.Note.EventStream-    Generated.ReplayDivergence.Note.Harness-    Generated.ReplayDivergence.Note.Projection-    Generated.ReplayDivergence.Note.Transducer-    Generated.ReplayDivergence.ReplayAudit-    ReplayDivergence.Note.Holes--  build-depends:-    , aeson  >=2.2  && <2.3-    , base   >=4.21 && <5-    , keiki  >=0.9  && <0.10-    , keiro-    , text   >=2.1  && <2.2--benchmark keiro-dsl-codec-bench-  import:         warnings, shared-  type:           exitcode-stdio-1.0-  hs-source-dirs: bench/structural-codec test/conformance-structural-  main-is:        Main.hs-  other-modules:-    Conformance.Structural.Bindings-    Conformance.Structural.Domain-    Generated.StructuralConformance.ArtifactCatalog.Codec-    Generated.StructuralConformance.ArtifactCatalog.Domain-    Generated.StructuralConformance.Structural.Shape.ArtifactInfo-    Generated.StructuralConformance.Structural.Shape.ArtifactKind-    Generated.StructuralConformance.Structural.Shape.ArtifactLocation-    Generated.StructuralConformance.Structural.Shape.ArtifactMetadata--  build-depends:-    , aeson        >=2.2  && <2.3-    , base         >=4.21 && <5-    , containers   >=0.6  && <0.8-    , deepseq      >=1.5  && <1.6-    , keiki        >=0.9  && <0.10-    , keiro-    , tasty-bench  >=0.5  && <0.6-    , text         >=2.1  && <2.2-    , time         >=1.12 && <1.15--benchmark keiro-dsl-parser-bench-  import:         warnings, shared-  type:           exitcode-stdio-1.0-  hs-source-dirs: bench/parser-scaling-  main-is:        Main.hs-  build-depends:-    , base         >=4.21 && <5-    , containers   >=0.6  && <0.8-    , deepseq      >=1.5  && <1.6-    , keiro-dsl-    , tasty-bench  >=0.5  && <0.6-    , text         >=2.1  && <2.2---- EP-109 M2: snapshot-enabled aggregate scaffolding compiled against the live--- defaultStateCodec and stream-construction guards, with the captured codec--- identity checked against keiki's regFileShapeHash.-test-suite keiro-dsl-conformance-snapshot-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-snapshot-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.BehaviorSourceMap-    Generated.HospitalCapacity.Nominals-    Generated.HospitalCapacity.Nominals.Internal-    Generated.HospitalCapacity.ReplayAudit-    Generated.HospitalCapacity.Reservation.Codec-    Generated.HospitalCapacity.Reservation.Domain-    Generated.HospitalCapacity.Reservation.EventStream-    Generated.HospitalCapacity.Reservation.Transducer-    HospitalCapacity.Reservation.Holes--  build-depends:-    , aeson  >=2.2  && <2.3-    , base   >=4.21 && <5-    , keiki  >=0.9  && <0.10-    , keiro-    , text   >=2.1  && <2.2---- EP-106 M6: every distinct `new <kind>` skeleton is scaffolded into this--- committed tree. Compiling the union proves a starter that passes `check`--- cannot emit syntactically or type-invalid Haskell.--- The only corpus suite whose hole modules are deliberately *unfilled*: it--- exists to prove `keiro-dsl new <kind>` scaffolds a skeleton that compiles, so--- its create-once files still carry their `-- HOLE` markers. A template cannot--- be clean under -Wunused-imports/-Wunused-matches by construction — its imports--- and its command binder are there for the fill that has not happened yet — so--- those two classes are non-fatal here and everywhere-else-fatal. Every other--- warning class remains an error, and the generated modules in this suite are--- held to the same standard as the rest of the corpus.-test-suite keiro-dsl-conformance-skeletons-  import:         warnings, generated-output-  ghc-options:    -Wno-error=unused-imports -Wno-error=unused-matches-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-skeletons-  main-is:        Main.hs-  other-modules:-    SkelAggregate.Generated.MyService.Nominals-    SkelAggregate.Generated.MyService.Nominals.Internal-    SkelAggregate.Generated.MyService.ReplayAudit-    SkelAggregate.Generated.MyService.Thing.BehaviorContract-    SkelAggregate.Generated.MyService.Thing.Codec-    SkelAggregate.Generated.MyService.Thing.Domain-    SkelAggregate.Generated.MyService.Thing.EventStream-    SkelAggregate.Generated.MyService.Thing.Harness-    SkelAggregate.Generated.MyService.Thing.Projection-    SkelAggregate.Generated.MyService.Thing.Transducer-    SkelAggregate.MyService.Thing.BehaviorHoles-    SkelAggregate.MyService.Thing.Holes-    SkelContract.Generated.MyService.MyContract.Contract-    SkelEmit.Generated.MyService.MyContract.Contract-    SkelEmit.Generated.MyService.ThingPublisher.Publisher-    SkelIntake.Generated.MyService.MyContract.Contract-    SkelIntake.Generated.MyService.ThingInbox.Inbox-    SkelProcess.Generated.MyService.Hospital.Codec-    SkelProcess.Generated.MyService.Hospital.Domain-    SkelProcess.Generated.MyService.Hospital.EventStream-    SkelProcess.Generated.MyService.Hospital.Harness-    SkelProcess.Generated.MyService.Hospital.Projection-    SkelProcess.Generated.MyService.Hospital.Transducer-    SkelProcess.Generated.MyService.HospitalSurge.Process-    SkelProcess.Generated.MyService.HospitalSurge.ProcessHarness-    SkelProcess.Generated.MyService.Nominals-    SkelProcess.Generated.MyService.Nominals.Internal-    SkelProcess.Generated.MyService.ReplayAudit-    SkelProcess.Generated.MyService.Surge.Codec-    SkelProcess.Generated.MyService.Surge.Domain-    SkelProcess.Generated.MyService.Surge.EventStream-    SkelProcess.Generated.MyService.Surge.Harness-    SkelProcess.Generated.MyService.Surge.Projection-    SkelProcess.Generated.MyService.Surge.Transducer-    SkelProcess.MyService.Hospital.Holes-    SkelProcess.MyService.HospitalSurge.ProcessHoles-    SkelProcess.MyService.Surge.Holes-    SkelQueue.Generated.MyService.AcceptedTransferNeeds.ReadModel-    SkelQueue.Generated.MyService.AcceptedTransferNeeds.ReadModelHarness-    SkelQueue.Generated.MyService.AcceptedTransferNeeds.ReadModelTable-    SkelQueue.Generated.MyService.ReservationWork.Queue-    SkelQueue.Generated.MyService.ReservationWork.QueueCodec-    SkelQueue.Generated.MyService.ReservationWork.QueuePolicy-    SkelQueue.Generated.MyService.TransferDecisions.ReadModel-    SkelQueue.Generated.MyService.TransferDecisions.ReadModelHarness-    SkelQueue.Generated.MyService.TransferDecisions.ReadModelTable-    SkelQueue.MyService.AcceptedTransferNeeds.ReadModelHoles-    SkelQueue.MyService.TransferDecisions.ReadModelHoles-    SkelRouter.Generated.MyService.Page.Codec-    SkelRouter.Generated.MyService.Page.Domain-    SkelRouter.Generated.MyService.Page.EventStream-    SkelRouter.Generated.MyService.Page.Harness-    SkelRouter.Generated.MyService.Page.Projection-    SkelRouter.Generated.MyService.Page.Transducer-    SkelRouter.Generated.MyService.PagingRouter.Router-    SkelRouter.Generated.MyService.PagingRouter.RouterHarness-    SkelRouter.Generated.MyService.ReplayAudit-    SkelRouter.MyService.Page.Holes-    SkelRouter.MyService.PagingRouter.RouterHoles-    SkelWorkflow.Generated.MyService.HospitalTransferReservation.WorkflowFacts-    SkelWorkflow.Generated.MyService.HospitalTransferReservation.WorkflowRuntime--  build-depends:-    , aeson              >=2.2  && <2.3-    , base               >=4.21 && <5-    , containers-    , effectful-core-    , hasql-transaction-    , keiki              >=0.9  && <0.10-    , keiro-    , keiro-core-    , keiro-pgmq-    , kiroku-store-    , mmzk-typeid        >=0.7  && <0.8-    , shibuya-core-    , text               >=2.1  && <2.2-    , time-    , uuid---- EP-7 cold-start: a fresh `subscription` aggregate authored from only the skill--- notation, scaffolded + hand-filled, compiling against keiki/keiro with a green--- spec-derived harness — proof the authoring loop closes on a non-corpus spec.-test-suite keiro-dsl-conformance-coldstart-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-coldstart-  main-is:        Main.hs-  other-modules:-    Billing.Subscription.Holes-    Generated.Billing.BehaviorSourceMap-    Generated.Billing.Nominals-    Generated.Billing.Nominals.Internal-    Generated.Billing.ReplayAudit-    Generated.Billing.Subscription.Codec-    Generated.Billing.Subscription.Domain-    Generated.Billing.Subscription.EventStream-    Generated.Billing.Subscription.Harness-    Generated.Billing.Subscription.Projection-    Generated.Billing.Subscription.Transducer--  build-depends:-    , aeson  >=2.2  && <2.3-    , base   >=4.21 && <5-    , keiki  >=0.9  && <0.10-    , keiro-    , text   >=2.1  && <2.2---- Stable language-4 contract conformance: prefix-indexed KindID fields,--- canonical text JSON, field-path-aware rejection, and the complete generated--- dependency set.-test-suite keiro-dsl-conformance-contract-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-contract-  main-is:        Main.hs-  other-modules:  Generated.HospitalCapacity.Emergency.Contract-  build-depends:-    , aeson        >=2.2  && <2.3-    , base         >=4.21 && <5-    , keiro-core-    , mmzk-typeid  >=0.7  && <0.8-    , text         >=2.1  && <2.2---- Language-1 compatibility proof: the historical permissive Text contract DTO--- still accepts pre-TypeID-v7 samples and retains its released JSON image.-test-suite keiro-dsl-conformance-contract-v1-compat-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-contract-v1-compat-  main-is:        Main.hs-  other-modules:  Generated.HospitalCapacity.Emergency.Contract-  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , bytestring  >=0.12 && <0.13-    , text        >=2.1  && <2.2---- EP-4 intake runtime conformance: the scaffolded Inbox disposition + dedupe--- policy compiled against the LIVE Keiro.Inbox.Types (InboxResult / dedupe).-test-suite keiro-dsl-conformance-intake-runtime-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-intake-runtime-  main-is:        Main.hs-  other-modules:  Generated.HospitalCapacity.IncidentInbox.Inbox-  build-depends:-    , base   >=4.21 && <5-    , keiro-    , text   >=2.1  && <2.2---- EP-4 M5 full-service conformance: a complete integration service — scaffolded--- inbox dedupe + a filled inbox transaction runner and outbox IntegrationProducer--- — compiled against the live keiro runtime (Inbox / Outbox / Kiroku.Store).-test-suite keiro-dsl-conformance-intake-full-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-intake-full-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.IncidentInbox.Inbox-    HospitalCapacity.IncidentInbox.Integration--  build-depends:-    , base               >=4.21 && <5-    , effectful-core-    , hasql-transaction-    , keiro-    , kiroku-store       >=0.8  && <0.9-    , text               >=2.1  && <2.2---- EP-4 publisher runtime conformance: the scaffolded Publisher config compiled--- against the LIVE Keiro.Outbox.Types (OrderingPolicy / BackoffSchedule).-test-suite keiro-dsl-conformance-publisher-runtime-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-publisher-runtime-  main-is:        Main.hs-  other-modules:  Generated.HospitalCapacity.HospitalPublisher.Publisher-  build-depends:-    , base   >=4.21 && <5-    , keiro---- pgmq Job codec conformance (EP-5): the scaffolded self-contained Job payload--- record + field->wire codec, compiled + round-tripped.-test-suite keiro-dsl-conformance-queue-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-queue-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.ReservationWork.Queue-    Generated.HospitalCapacity.ReservationWork.QueueCodec--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , keiro-core-    , keiro-pgmq-    , text        >=2.1  && <2.2---- EP-5 pgmq runtime conformance: the scaffolded QueuePolicy (RetryPolicy +--- JobOutcome disposition) compiled against the LIVE Keiro.PGMQ.Job runtime.-test-suite keiro-dsl-conformance-queue-runtime-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-queue-runtime-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.ReservationWork.Queue-    Generated.HospitalCapacity.ReservationWork.QueueCodec-    Generated.HospitalCapacity.ReservationWork.QueuePolicy--  build-depends:-    , aeson        >=2.2  && <2.3-    , base         >=4.21 && <5-    , bytestring   >=0.12 && <0.13-    , keiro-core-    , keiro-dsl-    , keiro-pgmq-    , pgmq-config-    , pgmq-core-    , text         >=2.1  && <2.2---- EP-107 read-model runtime conformance: the scaffolded ReadModel record,--- registration/rebuild helpers, AsyncProjection, facts harness, and a filled--- qualified-table query compiled against the live Keiro.ReadModel API.-test-suite keiro-dsl-conformance-readmodel-runtime-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-readmodel-runtime-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.TransferDecisions.ReadModel-    Generated.HospitalCapacity.TransferDecisions.ReadModelHarness-    Generated.HospitalCapacity.TransferDecisions.ReadModelTable-    HospitalCapacity.TransferDecisions.ReadModelHoles--  build-depends:-    , base               >=4.21 && <5-    , effectful-core-    , hasql-transaction-    , keiro-    , kiroku-store-    , text               >=2.1  && <2.2---- MasterPlan 32 / EP-4: language-5 catalog declarations lower into one--- generated runtime-owned facade with typed inline views, catalog-derived--- async/query registration, and a group-scoped history-runner entry point.-test-suite keiro-dsl-conformance-projection-catalog-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-projection-catalog-  main-is:        Main.hs-  other-modules:-    CatalogDemo.CatalogAudit.ReadModelHoles-    CatalogDemo.MappedBindings-    CatalogDemo.MappedDomain-    CatalogDemo.OrderInline.ReadModelHoles-    CatalogDemo.Orders.BehaviorHoles-    CatalogDemo.Orders.Holes-    CatalogDemo.OrderTotalsLookup.ReadModelHoles-    CatalogDemo.ProjectionCatalog.ProjectionCatalogHoles-    CatalogDemo.ShipmentLookup.ReadModelHoles-    CatalogDemo.Shipments.BehaviorHoles-    Generated.CatalogDemo.BehaviorSourceMap-    Generated.CatalogDemo.CatalogAudit.ReadModel-    Generated.CatalogDemo.CatalogAudit.ReadModelHarness-    Generated.CatalogDemo.CatalogAudit.ReadModelTable-    Generated.CatalogDemo.OrderInline.QueryContract-    Generated.CatalogDemo.OrderInline.ReadModel-    Generated.CatalogDemo.OrderInline.ReadModelHarness-    Generated.CatalogDemo.OrderInline.ReadModelTable-    Generated.CatalogDemo.Orders.BehaviorContract-    Generated.CatalogDemo.Orders.Codec-    Generated.CatalogDemo.Orders.Domain-    Generated.CatalogDemo.Orders.EventStream-    Generated.CatalogDemo.Orders.Harness-    Generated.CatalogDemo.Orders.Projection-    Generated.CatalogDemo.Orders.Transducer-    Generated.CatalogDemo.OrderTotalsLookup.ReadModel-    Generated.CatalogDemo.OrderTotalsLookup.ReadModelHarness-    Generated.CatalogDemo.OrderTotalsLookup.ReadModelTable-    Generated.CatalogDemo.ProjectionCatalog-    Generated.CatalogDemo.QualificationJobs.Queue-    Generated.CatalogDemo.QualificationJobs.QueueCodec-    Generated.CatalogDemo.QualificationJobs.QueuePolicy-    Generated.CatalogDemo.ReplayAudit-    Generated.CatalogDemo.ShipmentLookup.ReadModel-    Generated.CatalogDemo.ShipmentLookup.ReadModelHarness-    Generated.CatalogDemo.ShipmentLookup.ReadModelTable-    Generated.CatalogDemo.Shipments.BehaviorContract-    Generated.CatalogDemo.Shipments.Codec-    Generated.CatalogDemo.Shipments.Domain-    Generated.CatalogDemo.Shipments.EventStream-    Generated.CatalogDemo.Shipments.Harness-    Generated.CatalogDemo.Shipments.Projection-    Generated.CatalogDemo.Shipments.Transducer-    Generated.CatalogDemo.Structural.Shape.QualificationPayload-    Generated.CatalogDemo.StructuralConformance-    Generated.CatalogDemo.StructuralProjections--  build-depends:-    , aeson              >=2.2  && <2.3-    , base               >=4.21 && <5-    , containers         >=0.6  && <0.8-    , effectful-core-    , hasql-transaction-    , keiki              >=0.9  && <0.10-    , keiro-    , keiro-core-    , keiro-dsl-    , keiro-pgmq-    , kiroku-store-    , text               >=2.1  && <2.2---- EP-5 M5 full-service conformance: a complete pgmq dispatch service — scaffolded--- Job codec + retry policy + a filled worker handler assembled into a live--- Keiro.PGMQ.Job.Job value — compiled against keiro-pgmq.-test-suite keiro-dsl-conformance-dispatch-full-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-dispatch-full-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.ReservationWork.Queue-    Generated.HospitalCapacity.ReservationWork.QueueCodec-    Generated.HospitalCapacity.ReservationWork.QueuePolicy-    HospitalCapacity.ReservationWork.WorkqueueJob--  build-depends:-    , aeson           >=2.2  && <2.3-    , base            >=4.21 && <5-    , effectful-core-    , keiro-core-    , keiro-pgmq-    , text            >=2.1  && <2.2---- Workflow facts harness (EP-6): the scaffolded self-contained WorkflowFacts--- module asserted against a hand-written expectation (mutation-pinnable).-test-suite keiro-dsl-conformance-workflow-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-workflow-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.HospitalTransferReservation.WorkflowFacts--  build-depends:  base >=4.21 && <5---- Workflow runtime conformance: the scaffolded WorkflowRuntime allocates its--- declared await through the live Keiro.Workflow effect and exercises the--- returned opaque id against PostgreSQL.-test-suite keiro-dsl-conformance-workflow-runtime-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-workflow-runtime-  main-is:        Main.hs-  ghc-options:    -threaded -rtsopts -with-rtsopts=-N-  other-modules:-    Generated.HospitalCapacity.HospitalTransferReservation.WorkflowRuntime--  build-depends:-    , aeson               >=2.2  && <2.3-    , base                >=4.21 && <5-    , containers-    , effectful-core-    , keiro-    , keiro-test-support-    , kiroku-store-    , text                >=2.1  && <2.2---- EP-3 M5 full-service conformance: a complete process service — the scaffolded--- Surge (saga) + Hospital (target) aggregates with filled transducers, plus a--- filled ProcessManager handle — compiled against the live keiro/keiki runtime.-test-suite keiro-dsl-conformance-process-full-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-process-full-  main-is:        Main.hs-  other-modules:-    Generated.SurgeDemo.BehaviorSourceMap-    Generated.SurgeDemo.Hospital.Codec-    Generated.SurgeDemo.Hospital.Domain-    Generated.SurgeDemo.Hospital.EventStream-    Generated.SurgeDemo.Hospital.Projection-    Generated.SurgeDemo.Hospital.Transducer-    Generated.SurgeDemo.Nominals-    Generated.SurgeDemo.Nominals.Internal-    Generated.SurgeDemo.ReplayAudit-    Generated.SurgeDemo.Surge.Codec-    Generated.SurgeDemo.Surge.Domain-    Generated.SurgeDemo.Surge.EventStream-    Generated.SurgeDemo.Surge.Projection-    Generated.SurgeDemo.Surge.Transducer-    Generated.SurgeDemo.SurgeFlow.Process-    SurgeDemo.Hospital.Holes-    SurgeDemo.Surge.Holes-    SurgeDemo.SurgeFlow.Manager--  build-depends:-    , aeson         >=2.2  && <2.3-    , base          >=4.21 && <5-    , keiki         >=0.9  && <0.10-    , keiro-    , shibuya-core-    , text          >=2.1  && <2.2-    , time          >=1.12 && <1.15-    , uuid          >=1.3  && <1.4---- EP-6 M5 full-service conformance: a complete durable workflow — scaffolded--- WorkflowRuntime + a filled ordered step/await body — compiled against the--- live Keiro.Workflow effect.-test-suite keiro-dsl-conformance-workflow-full-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-workflow-full-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.HospitalTransferReservation.WorkflowRuntime-    HospitalCapacity.HospitalTransferReservation.WorkflowBody--  build-depends:-    , aeson           >=2.2  && <2.3-    , base            >=4.21 && <5-    , containers-    , effectful-core-    , keiro-    , kiroku-store-    , text            >=2.1  && <2.2---- EP-3 process runtime conformance: the scaffolded Process module's--- deterministic wiring (timer-request builder + fire disposition) compiled--- against the LIVE keiro runtime (Keiro.Timer / Keiro.Command), not just text.-test-suite keiro-dsl-conformance-process-runtime-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-process-runtime-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.BehaviorSourceMap-    Generated.HospitalCapacity.HospitalSurge.Process-    Generated.HospitalCapacity.Nominals-    Generated.HospitalCapacity.Nominals.Internal-    Generated.HospitalCapacity.Surge.Codec-    Generated.HospitalCapacity.Surge.Domain-    Generated.HospitalCapacity.Surge.EventStream-    Generated.HospitalCapacity.Surge.Transducer-    HospitalCapacity.Surge.Holes--  build-depends:-    , aeson         >=2.2  && <2.3-    , base          >=4.21 && <5-    , keiki         >=0.9  && <0.10-    , keiro-    , keiro-dsl-    , shibuya-core-    , text          >=2.1  && <2.2-    , time          >=1.12 && <1.15-    , uuid          >=1.3  && <1.4---- EP-108 router runtime conformance: generated policy lowering and the live--- target-keyed deterministic id contract.-test-suite keiro-dsl-conformance-router-runtime-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-router-runtime-  main-is:        Main.hs-  other-modules:-    Generated.IncidentPaging.BehaviorSourceMap-    Generated.IncidentPaging.PagingRouter.Router-    Generated.IncidentPaging.PagingRouter.RouterHarness--  build-depends:-    , base          >=4.21 && <5-    , keiro-    , kiroku-store-    , shibuya-core-    , text          >=2.1  && <2.2-    , uuid          >=1.3  && <1.4---- Plan 230: the checked language-5 selection is generated, compiled against--- the public runtime, and exercised through a real read-model query and ledger.-test-suite keiro-dsl-conformance-declarative-router-  import:         generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-declarative-router-  main-is:        Main.hs-  ghc-options:    -threaded -rtsopts -with-rtsopts=-N-  other-modules:-    Conformance.DeclarativeRouter.Bindings-    Conformance.DeclarativeRouter.Domain-    Generated.TransferRouting.BehaviorSourceMap-    Generated.TransferRouting.Hospital.BehaviorContract-    Generated.TransferRouting.Hospital.Codec-    Generated.TransferRouting.Hospital.Domain-    Generated.TransferRouting.Hospital.EventStream-    Generated.TransferRouting.Hospital.Harness-    Generated.TransferRouting.Hospital.Projection-    Generated.TransferRouting.Hospital.Transducer-    Generated.TransferRouting.HospitalLoad.QueryContract-    Generated.TransferRouting.HospitalLoad.ReadModel-    Generated.TransferRouting.HospitalLoad.ReadModelHarness-    Generated.TransferRouting.HospitalLoad.ReadModelTable-    Generated.TransferRouting.HospitalTransferRouter.Router-    Generated.TransferRouting.HospitalTransferRouter.RouterHarness-    Generated.TransferRouting.ProjectionCatalog-    Generated.TransferRouting.ReplayAudit-    Generated.TransferRouting.Structural.Shape.HospitalLoadRow-    Generated.TransferRouting.Structural.Shape.TransferRouteInput-    Generated.TransferRouting.StructuralConformance-    Generated.TransferRouting.StructuralProjections-    TransferRouting.Hospital.BehaviorHoles-    TransferRouting.HospitalLoad.ReadModelHoles-    TransferRouting.ProjectionCatalog.ProjectionCatalogHoles--  build-depends:-    , aeson               >=2.2      && <2.3-    , base                >=4.21     && <5-    , bytestring          >=0.11     && <0.13-    , containers          >=0.6      && <0.8-    , effectful-core-    , hasql               >=1.10     && <1.11-    , hasql-transaction   >=1.1      && <1.3-    , keiki               >=0.9      && <0.10-    , keiro-    , keiro-dsl-    , keiro-test-support-    , kiroku-store        >=0.8      && <0.9-    , shibuya-core        ^>=0.9.0.0-    , text                >=2.1      && <2.2-    , time                >=1.12     && <1.15-    , uuid                >=1.3      && <1.4-    , vector              >=0.13     && <0.14---- EP-108 generated router-facts harness with hand-written expectations.-test-suite keiro-dsl-conformance-router-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-router-  main-is:        Main.hs-  other-modules:-    Generated.IncidentPaging.BehaviorSourceMap-    Generated.IncidentPaging.PagingRouter.RouterHarness--  build-depends:-    , base  >=4.21 && <5-    , text  >=2.1  && <2.2---- EP-108 filled-router conformance: scaffolded Page aggregate plus a filled--- resolver and Router value compiled against the live API.-test-suite keiro-dsl-conformance-router-full-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-router-full-  main-is:        Main.hs-  other-modules:-    Generated.IncidentPaging.BehaviorSourceMap-    Generated.IncidentPaging.Page.Codec-    Generated.IncidentPaging.Page.Domain-    Generated.IncidentPaging.Page.EventStream-    Generated.IncidentPaging.Page.Transducer-    Generated.IncidentPaging.PagingRouter.Router-    Generated.IncidentPaging.PagingRouter.RouterHarness-    Generated.IncidentPaging.ReplayAudit-    IncidentPaging.Page.Holes-    IncidentPaging.PagingRouter.RouterValue--  build-depends:-    , aeson           >=2.2  && <2.3-    , base            >=4.21 && <5-    , effectful-core-    , keiki           >=0.9  && <0.10-    , keiro-    , shibuya-core-    , text            >=2.1  && <2.2---- MP-15/EP-110 M6 cold-start: a fresh agent, given only the authoring skill--- and feature sentence, produced this aggregate + readmodel + router service.--- The component compiles generated output and hand-owned fills together and--- runs the aggregate, readmodel, router-policy, and live Router assertions.-test-suite keiro-dsl-conformance-newsurface-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-newsurface-  main-is:        Main.hs-  other-modules:-    Generated.TransferRouting.BehaviorSourceMap-    Generated.TransferRouting.Conformance-    Generated.TransferRouting.Hospital.Codec-    Generated.TransferRouting.Hospital.Domain-    Generated.TransferRouting.Hospital.EventStream-    Generated.TransferRouting.Hospital.Harness-    Generated.TransferRouting.Hospital.Projection-    Generated.TransferRouting.Hospital.Transducer-    Generated.TransferRouting.HospitalLoad.ReadModel-    Generated.TransferRouting.HospitalLoad.ReadModelHarness-    Generated.TransferRouting.HospitalLoad.ReadModelTable-    Generated.TransferRouting.HospitalTransferRouter.Router-    Generated.TransferRouting.HospitalTransferRouter.RouterHarness-    Generated.TransferRouting.ReplayAudit-    TransferRouting.Hospital.Holes-    TransferRouting.HospitalLoad.ReadModelHoles-    TransferRouting.HospitalTransferRouter.RouterHoles-    TransferRouting.HospitalTransferRouter.RouterValue--  build-depends:-    , aeson              >=2.2  && <2.3-    , base               >=4.21 && <5-    , effectful-core-    , hasql-transaction-    , keiki              >=0.9  && <0.10-    , keiro-    , kiroku-store-    , shibuya-core-    , text               >=2.1  && <2.2---- Process-manager facts harness (EP-3 M4): the self-contained, firewall-clean--- ProcessHarness module scaffolded from hospital-surge.keiro, compiled + run to--- prove the scaffolder lowered the spec's deterministic process/timer decisions--- faithfully. (The runtime-coupled Process/ProcessHoles modules are emitted to--- disk but not in this component; their live conformance is the M5 step.)-test-suite keiro-dsl-conformance-process-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-process-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.BehaviorSourceMap-    Generated.HospitalCapacity.HospitalSurge.ProcessHarness--  build-depends:-    , base  >=4.21 && <5-    , text  >=2.1  && <2.2---- Conformance for the evolved (v2) Reservation aggregate: proves the scaffolded--- Codec schemaVersion=2 + upcasters wiring compiles and that the filled upcaster--- migrates a v1-tagged payload through the chain (the harness "upcaster wired"--- assertion). These sources are raw `keiro-dsl scaffold` output of--- reservation-v2.keiro plus a hand-filled Holes.hs.-test-suite keiro-dsl-conformance-v2-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-v2-  main-is:        Main.hs-  other-modules:-    Generated.HospitalCapacity.BehaviorSourceMap-    Generated.HospitalCapacity.Nominals-    Generated.HospitalCapacity.Nominals.Internal-    Generated.HospitalCapacity.ReplayAudit-    Generated.HospitalCapacity.Reservation.Codec-    Generated.HospitalCapacity.Reservation.Domain-    Generated.HospitalCapacity.Reservation.EventStream-    Generated.HospitalCapacity.Reservation.Harness-    Generated.HospitalCapacity.Reservation.Projection-    Generated.HospitalCapacity.Reservation.Transducer-    HospitalCapacity.Reservation.Holes--  build-depends:-    , aeson      >=2.2  && <2.3-    , base       >=4.21 && <5-    , directory  >=1.3  && <1.4-    , keiki      >=0.9  && <0.10-    , keiro-    , text       >=2.1  && <2.2---- IR-14 / EP-171 migration conformance. The generated v3 public ID surface--- rejects malformed current input while its explicitly internal event-replay--- seam preserves identical malformed text from a legacy payload.-test-suite keiro-dsl-conformance-id-domain-migration-  import:         warnings, generated-output-  type:           exitcode-stdio-1.0-  hs-source-dirs: test/conformance-id-domain-migration-  main-is:        Main.hs-  other-modules:-    Generated.IdDomainMigration.BehaviorSourceMap-    Generated.IdDomainMigration.Nominals-    Generated.IdDomainMigration.Nominals.Internal-    Generated.IdDomainMigration.OrderBook.Codec-    Generated.IdDomainMigration.OrderBook.Domain--  build-depends:-    , aeson       >=2.2  && <2.3-    , base        >=4.21 && <5-    , keiki       >=0.9  && <0.10-    , keiro-core-    , text        >=2.1  && <2.2+cabal-version: 3.0+name: keiro-dsl+version: 0.17.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+  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++common shared+  default-language: GHC2024+  default-extensions:+    DuplicateRecordFields+    ImportQualifiedPost+    LambdaCase+    NoFieldSelectors+    OverloadedLabels+    OverloadedRecordDot+    OverloadedStrings++-- Every component importing this stanza compiles only `keiro-dsl scaffold`+-- output plus hand-filled holes. Generated code is regenerated wholesale, so a+-- warning in it is a generator defect with nothing for a human to fix in place:+-- -Werror keeps such a regression from building green. This is deliberately not+-- added to `warnings`, where src/ keeps -Wall non-fatal. Hackage rejects an+-- unconditional -Werror, so the gate rides a manual flag that this repository's+-- cabal.project switches on; the published sdist defaults it off.+flag werror-generated+  description:+    Promote warnings in committed generated conformance output to errors++  manual: True+  default: False++common generated-output+  default-language: GHC2024+  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+  -- user-maintained and cannot act on Keiro's Haskell API deprecations, so keep+  -- them compilable under the generated-output -Werror gate. Candidate Language+  -- 5 emits the truthful API and does not rely on this compatibility allowance.+  ghc-options: -Wno-deprecations++  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+  autogen-modules: Paths_keiro_dsl+  exposed-modules:+    Keiro.Dsl.AggregateType+    Keiro.Dsl.BehaviorCoverage+    Keiro.Dsl.BehaviorSourceMap+    Keiro.Dsl.CanonicalEncoding+    Keiro.Dsl.CheckReport+    Keiro.Dsl.CodecCompare+    Keiro.Dsl.ConformancePackage+    Keiro.Dsl.ConsumerTypePlan+    Keiro.Dsl.CoordinationImpact+    Keiro.Dsl.Coverage+    Keiro.Dsl.Diff+    Keiro.Dsl.DiffReport+    Keiro.Dsl.EventOutput+    Keiro.Dsl.ExplainBindings+    Keiro.Dsl.Expression+    Keiro.Dsl.FoldFingerprint+    Keiro.Dsl.Frontend+    Keiro.Dsl.Goldens+    Keiro.Dsl.Grammar+    Keiro.Dsl.Harness+    Keiro.Dsl.HaskellImport+    Keiro.Dsl.HaskellSourceMove+    Keiro.Dsl.IdDomain+    Keiro.Dsl.LanguageVersion+    Keiro.Dsl.Manifest+    Keiro.Dsl.MappedCodecPlan+    Keiro.Dsl.MappedConsumer+    Keiro.Dsl.MappedDiff+    Keiro.Dsl.NominalType+    Keiro.Dsl.Parser+    Keiro.Dsl.PrettyPrint+    Keiro.Dsl.ProcessReaction+    Keiro.Dsl.ProjectionMappedImpact+    Keiro.Dsl.ProjectionSupply+    Keiro.Dsl.ReadModelQueryContract+    Keiro.Dsl.ReadModelShape+    Keiro.Dsl.ReplayImpact+    Keiro.Dsl.RouterSelection+    Keiro.Dsl.RuntimePackage+    Keiro.Dsl.Scaffold+    Keiro.Dsl.ScaffoldRecord+    Keiro.Dsl.ScaffoldRun+    Keiro.Dsl.SemanticContract+    Keiro.Dsl.SemanticImpact+    Keiro.Dsl.ServiceHarness+    Keiro.Dsl.SidecarMigration+    Keiro.Dsl.SidecarNames+    Keiro.Dsl.Skeleton+    Keiro.Dsl.Source+    Keiro.Dsl.SourceIndex+    Keiro.Dsl.StructuralConformance+    Keiro.Dsl.Syntax+    Keiro.Dsl.TransitionFamily+    Keiro.Dsl.TypeGraph+    Keiro.Dsl.Validate+    Keiro.Dsl.Workspace+    Keiro.Dsl.WorkspaceAdoption+    Keiro.Dsl.WorkspaceDiff+    Keiro.Dsl.WorkspaceRecord+    Keiro.Dsl.WorkspaceScaffold++  other-modules:+    Keiro.Dsl.AggregateGenerationPlan+    Keiro.Dsl.FieldIdentity+    Keiro.Dsl.Frontend.Internal+    Keiro.Dsl.HaskellName+    Keiro.Dsl.Parser.Aggregate+    Keiro.Dsl.Parser.Coordination+    Keiro.Dsl.Parser.Core+    Keiro.Dsl.Parser.Declaration+    Keiro.Dsl.Parser.Document+    Keiro.Dsl.Parser.Expression+    Keiro.Dsl.Parser.Integration+    Keiro.Dsl.Parser.Mapped+    Keiro.Dsl.Parser.Preamble+    Keiro.Dsl.Parser.ProjectionCatalog+    Keiro.Dsl.Parser.Queue+    Keiro.Dsl.Parser.ReadModel+    Keiro.Dsl.Parser.Workflow+    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.17.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+  hs-source-dirs: app+  main-is: Main.hs+  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    directory >=1.3 && <1.4,+    filepath >=1.4 && <1.6,+    keiro-dsl,+    optparse-applicative >=0.18 && <0.20,+    process >=1.6 && <1.7,+    text >=2.1 && <2.2,++test-suite keiro-dsl-test+  import: warnings, shared+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-tool-depends: keiro-dsl:keiro-dsl+  autogen-modules: Paths_keiro_dsl+  other-modules:+    Keiro.Dsl.ConformanceBaseline+    Keiro.Dsl.FrontendCompatibility+    Keiro.Dsl.FrontendProfiles+    Keiro.Dsl.FrontendPublicApiProbe+    Keiro.Dsl.FrontendSurface+    Paths_keiro_dsl++  build-depends:+    QuickCheck >=2.14,+    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.17.0.0,+    keiro-dsl,+    keiro-dsl:generated-haskell-language-internal,+    mmzk-typeid >=0.7 && <0.8,+    process >=1.6 && <1.7,+    text >=2.1 && <2.2,++test-suite keiro-dsl-import-planning-test+  import: warnings, shared+  type: exitcode-stdio-1.0+  hs-source-dirs:+    test/import-planning+    src++  main-is: Main.hs+  other-modules:+    Keiro.Dsl.HaskellImport+    Keiro.Dsl.HaskellName++  build-depends:+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    hspec >=2.11,+    text >=2.1 && <2.2,++test-suite keiro-dsl-haskell-name-test+  import: warnings, shared+  type: exitcode-stdio-1.0+  hs-source-dirs:+    test/haskell-name+    src++  main-is: Main.hs+  other-modules: Keiro.Dsl.HaskellName+  build-depends:+    QuickCheck >=2.14,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    hspec >=2.11,+    text >=2.1 && <2.2,++-- Plan 199: keiro-dsl validates specs without depending on the keiro runtime+-- package, so a few runtime vocabularies are restated in Keiro.Dsl.Validate.+-- This suite depends on both packages and fails when a restatement drifts from+-- the definition it mirrors.+test-suite keiro-dsl-runtime-vocabulary-test+  import: warnings, shared+  type: exitcode-stdio-1.0+  hs-source-dirs: test/runtime-vocabulary+  main-is: Main.hs+  build-depends:+    base >=4.21 && <5,+    keiro ^>=0.17.0.0,+    keiro-dsl,+    shibuya-core ^>=0.9.0.0,+    text >=2.1 && <2.2,++-- Conformance: proves the scaffolded Generated modules plus a hand-filled+-- Holes.hs compile against keiki/keiro and that the filled transducer passes+-- keiki's validator and the codec round-trips. The Generated.* modules under+-- test/conformance/ are byte-identical to `keiro-dsl scaffold` output (pinned+-- by the scaffold-conformance test in keiro-dsl-test).+test-suite keiro-dsl-conformance+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.BehaviorSourceMap+    Generated.HospitalCapacity.Nominals+    Generated.HospitalCapacity.Nominals.Internal+    Generated.HospitalCapacity.ReplayAudit+    Generated.HospitalCapacity.Reservation.Codec+    Generated.HospitalCapacity.Reservation.Domain+    Generated.HospitalCapacity.Reservation.EventStream+    Generated.HospitalCapacity.Reservation.Harness+    Generated.HospitalCapacity.Reservation.Projection+    Generated.HospitalCapacity.Reservation.Transducer+    HospitalCapacity.Reservation.Holes++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.12 && <0.13,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,++-- Plan 157: compiled direct Time/Natural aggregate fields and registers,+-- symbolic equality/ordering, codecs, snapshots, forward/replay equality,+-- Natural JSON boundaries, canonical identity, and opaque arithmetic audit.+test-suite keiro-dsl-conformance-aggregate-scalars+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-aggregate-scalars+  main-is: Main.hs+  other-modules:+    AggregateScalars.ScalarLedger.Holes+    Generated.AggregateScalars.BehaviorSourceMap+    Generated.AggregateScalars.ReplayAudit+    Generated.AggregateScalars.ScalarLedger.Codec+    Generated.AggregateScalars.ScalarLedger.Domain+    Generated.AggregateScalars.ScalarLedger.EventStream+    Generated.AggregateScalars.ScalarLedger.Harness+    Generated.AggregateScalars.ScalarLedger.Projection+    Generated.AggregateScalars.ScalarLedger.Transducer++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,++-- Plan 161: compiled authoritative version-2 scalar expressions, generated+-- transition ownership, explicit Hole opacity/fold identity, and concrete,+-- symbolic, codec-replay, and snapshot-invalidation agreement.+test-suite keiro-dsl-conformance-aggregate-scalar-expressions+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-scalar-expressions+  main-is: Main.hs+  other-modules:+    AggregateScalarExpressions.ScalarAccount.BehaviorHoles+    AggregateScalarExpressions.ScalarAccount.Holes+    Generated.AggregateScalarExpressions.BehaviorSourceMap+    Generated.AggregateScalarExpressions.Nominals+    Generated.AggregateScalarExpressions.Nominals.Internal+    Generated.AggregateScalarExpressions.ReplayAudit+    Generated.AggregateScalarExpressions.ScalarAccount.BehaviorContract+    Generated.AggregateScalarExpressions.ScalarAccount.Codec+    Generated.AggregateScalarExpressions.ScalarAccount.Domain+    Generated.AggregateScalarExpressions.ScalarAccount.EventStream+    Generated.AggregateScalarExpressions.ScalarAccount.Harness+    Generated.AggregateScalarExpressions.ScalarAccount.Projection+    Generated.AggregateScalarExpressions.ScalarAccount.Transducer+    Generated.AggregateScalarExpressions.Structural.Shape.Limits+    Generated.AggregateScalarExpressions.StructuralConformance+    Generated.AggregateScalarExpressions.StructuralProjections+    ScalarExpressions.Bindings+    ScalarExpressions.Domain++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-dsl,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,++test-suite keiro-dsl-conformance-behavior-complete+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-behavior-complete+  main-is: Main.hs+  other-modules:+    BehaviorComplete.Bindings+    BehaviorComplete.Domain+    BehaviorComplete.Journey.BehaviorHoles+    BehaviorComplete.Journey.Holes+    Generated.BehaviorComplete.BehaviorSourceMap+    Generated.BehaviorComplete.Journey.BehaviorContract+    Generated.BehaviorComplete.Journey.Codec+    Generated.BehaviorComplete.Journey.Domain+    Generated.BehaviorComplete.Journey.EventStream+    Generated.BehaviorComplete.Journey.Harness+    Generated.BehaviorComplete.Journey.Projection+    Generated.BehaviorComplete.Journey.Transducer+    Generated.BehaviorComplete.Nominals+    Generated.BehaviorComplete.Nominals.Internal+    Generated.BehaviorComplete.ReplayAudit+    Generated.BehaviorComplete.Structural.Shape.StartPayload+    Generated.BehaviorComplete.StructuralConformance+    Generated.BehaviorComplete.StructuralProjections++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.12 && <0.13,+    containers >=0.6 && <0.8,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,++test-suite keiro-dsl-conformance-domain-outcomes+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-domain-outcomes+  main-is: Main.hs+  other-modules:+    DomainOutcomes.Reservation.BehaviorHoles+    Generated.DomainOutcomes.BehaviorSourceMap+    Generated.DomainOutcomes.Nominals+    Generated.DomainOutcomes.ReplayAudit+    Generated.DomainOutcomes.Reservation.BehaviorContract+    Generated.DomainOutcomes.Reservation.Codec+    Generated.DomainOutcomes.Reservation.Domain+    Generated.DomainOutcomes.Reservation.EventStream+    Generated.DomainOutcomes.Reservation.Harness+    Generated.DomainOutcomes.Reservation.Projection+    Generated.DomainOutcomes.Reservation.Transducer++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,++-- EP-158: consumer-owned direct IDs, enums, and nominal scalar wrappers,+-- checked KindID decoding, total bindings, projections, and snapshot caches.+test-suite keiro-dsl-conformance-nominal-scalars+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-nominal-scalars+  main-is: Main.hs+  other-modules:+    Generated.NominalScalars.BehaviorSourceMap+    Generated.NominalScalars.Nominal.Shape.OrderStatus+    Generated.NominalScalars.NominalLedger.BehaviorContract+    Generated.NominalScalars.NominalLedger.Codec+    Generated.NominalScalars.NominalLedger.Domain+    Generated.NominalScalars.NominalLedger.EventStream+    Generated.NominalScalars.NominalLedger.Harness+    Generated.NominalScalars.NominalLedger.Projection+    Generated.NominalScalars.NominalLedger.Transducer+    Generated.NominalScalars.NominalProjections+    Generated.NominalScalars.ReplayAudit+    NominalConformance.Bindings+    NominalConformance.Domain+    NominalScalars.NominalLedger.BehaviorHoles++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    keiki >=0.9 && <0.10,+    keiro,+    mmzk-typeid >=0.7 && <0.8,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,++-- EP-168 / IR-2: one workspace-level generated ID/enum authority is imported+-- by two aggregate rings. The driver passes values between both domain modules+-- and round-trips both generated event codecs, so duplicate nominal types fail+-- at compile time rather than escaping a path-only scaffold assertion.+test-suite keiro-dsl-conformance-workspace-nominals+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-workspace-nominals+  main-is: Main.hs+  other-modules:+    Generated.WorkspaceNominalProof.BehaviorSourceMap+    Generated.WorkspaceNominalProof.Nominals+    Generated.WorkspaceNominalProof.Nominals.Internal+    Generated.WorkspaceNominalProof.Project.BehaviorContract+    Generated.WorkspaceNominalProof.Project.Codec+    Generated.WorkspaceNominalProof.Project.Domain+    Generated.WorkspaceNominalProof.Project.EventStream+    Generated.WorkspaceNominalProof.Project.Harness+    Generated.WorkspaceNominalProof.Project.Projection+    Generated.WorkspaceNominalProof.Project.Transducer+    Generated.WorkspaceNominalProof.ProjectArtifact.BehaviorContract+    Generated.WorkspaceNominalProof.ProjectArtifact.Codec+    Generated.WorkspaceNominalProof.ProjectArtifact.Domain+    Generated.WorkspaceNominalProof.ProjectArtifact.EventStream+    Generated.WorkspaceNominalProof.ProjectArtifact.Harness+    Generated.WorkspaceNominalProof.ProjectArtifact.Projection+    Generated.WorkspaceNominalProof.ProjectArtifact.Transducer+    Generated.WorkspaceNominalProof.ReplayAudit+    Generated.WorkspaceNominalProof.Structural.NominalLeaves+    Generated.WorkspaceNominalProof.Structural.Shape.ArtifactClaim+    Generated.WorkspaceNominalProof.Structural.Shape.ProjectClaim+    Generated.WorkspaceNominalProof.StructuralConformance+    Generated.WorkspaceNominalProof.StructuralProjections+    WorkspaceNominalProof.Bindings+    WorkspaceNominalProof.Domain+    WorkspaceNominalProof.Project.BehaviorHoles+    WorkspaceNominalProof.ProjectArtifact.BehaviorHoles++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-core,+    keiro-dsl,+    mmzk-typeid >=0.7 && <0.8,+    text >=2.1 && <2.2,++-- Plan 150 / IR-1: compiled structural consumer bindings, declared-wire+-- codecs, generated projection witnesses, opaque boundaries, fixture branch+-- coverage, current payload goldens, and mapped-register replay equality.+test-suite keiro-dsl-conformance-structural+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-structural+  main-is: Main.hs+  other-modules:+    Conformance.Structural.Bindings+    Conformance.Structural.Domain+    Generated.StructuralConformance.ArtifactCatalog.BehaviorContract+    Generated.StructuralConformance.ArtifactCatalog.Codec+    Generated.StructuralConformance.ArtifactCatalog.Domain+    Generated.StructuralConformance.ArtifactCatalog.EventStream+    Generated.StructuralConformance.ArtifactCatalog.Harness+    Generated.StructuralConformance.ArtifactCatalog.Projection+    Generated.StructuralConformance.ArtifactCatalog.Transducer+    Generated.StructuralConformance.BehaviorSourceMap+    Generated.StructuralConformance.ReplayAudit+    Generated.StructuralConformance.Structural.Shape.ArtifactInfo+    Generated.StructuralConformance.Structural.Shape.ArtifactKind+    Generated.StructuralConformance.Structural.Shape.ArtifactLocation+    Generated.StructuralConformance.Structural.Shape.ArtifactMetadata+    Generated.StructuralConformance.StructuralConformance+    Generated.StructuralConformance.StructuralProjections+    StructuralConformance.ArtifactCatalog.Holes++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.12 && <0.13,+    containers >=0.6 && <0.8,+    deepseq >=1.5 && <1.6,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,++-- Plan 287 / IR-40: nominal ID and scalar admission remains authoritative+-- through structural records, unions, containers, queues, queries, and snapshots.+test-suite keiro-dsl-conformance-structural-nominals+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  default-extensions: OverloadedLabels+  hs-source-dirs:+    test/conformance-structural-nominals+    test/conformance-nominal-queue-only+    test/conformance-nominal-query-only++  main-is: Main.hs+  other-modules:+    Conformance.StructuralNominals.Bindings+    Conformance.StructuralNominals.Domain+    Conformance.StructuralNominals.Historical+    Generated.MappedNominalQueryOnly.Nominals+    Generated.MappedNominalQueryOnly.Nominals.Internal+    Generated.MappedNominalQueryOnly.ProjectionCatalog+    Generated.MappedNominalQueryOnly.StructuralConformance+    Generated.MappedNominalQueryOnly.TemplateLookup.QueryContract+    Generated.MappedNominalQueryOnly.TemplateLookup.ReadModel+    Generated.MappedNominalQueryOnly.TemplateLookup.ReadModelHarness+    Generated.MappedNominalQueryOnly.TemplateLookup.ReadModelTable+    Generated.MappedNominalQueueOnly.Nominals+    Generated.MappedNominalQueueOnly.Nominals.Internal+    Generated.MappedNominalQueueOnly.Structural.NominalLeaves+    Generated.MappedNominalQueueOnly.StructuralConformance+    Generated.MappedNominalQueueOnly.TemplateWork.Queue+    Generated.MappedNominalQueueOnly.TemplateWork.QueueCodec+    Generated.MappedNominalQueueOnly.TemplateWork.QueuePolicy+    Generated.StructuralNominalLeaves.BehaviorSourceMap+    Generated.StructuralNominalLeaves.Nominal.Shape.Channel+    Generated.StructuralNominalLeaves.NominalProjections+    Generated.StructuralNominalLeaves.Nominals+    Generated.StructuralNominalLeaves.Nominals.Internal+    Generated.StructuralNominalLeaves.ProjectionCatalog+    Generated.StructuralNominalLeaves.ReplayAudit+    Generated.StructuralNominalLeaves.Structural.CodecCompare.TemplateState+    Generated.StructuralNominalLeaves.Structural.NominalLeaves+    Generated.StructuralNominalLeaves.Structural.Shape.TemplateBook+    Generated.StructuralNominalLeaves.Structural.Shape.TemplateLookupInput+    Generated.StructuralNominalLeaves.Structural.Shape.TemplateLookupRow+    Generated.StructuralNominalLeaves.Structural.Shape.TemplateRef+    Generated.StructuralNominalLeaves.Structural.Shape.TemplateState+    Generated.StructuralNominalLeaves.StructuralConformance+    Generated.StructuralNominalLeaves.StructuralProjections+    Generated.StructuralNominalLeaves.TemplateCatalog.BehaviorContract+    Generated.StructuralNominalLeaves.TemplateCatalog.Codec+    Generated.StructuralNominalLeaves.TemplateCatalog.Domain+    Generated.StructuralNominalLeaves.TemplateCatalog.EventStream+    Generated.StructuralNominalLeaves.TemplateCatalog.Harness+    Generated.StructuralNominalLeaves.TemplateCatalog.Projection+    Generated.StructuralNominalLeaves.TemplateCatalog.Transducer+    Generated.StructuralNominalLeaves.TemplateDeliveryRouter.Router+    Generated.StructuralNominalLeaves.TemplateDeliveryRouter.RouterHarness+    Generated.StructuralNominalLeaves.TemplateLookup.QueryContract+    Generated.StructuralNominalLeaves.TemplateLookup.ReadModel+    Generated.StructuralNominalLeaves.TemplateLookup.ReadModelHarness+    Generated.StructuralNominalLeaves.TemplateLookup.ReadModelTable+    Generated.StructuralNominalLeaves.TemplateWork.Queue+    Generated.StructuralNominalLeaves.TemplateWork.QueueCodec+    Generated.StructuralNominalLeaves.TemplateWork.QueuePolicy+    MappedNominalQueryOnly.ProjectionCatalog.ProjectionCatalogHoles+    MappedNominalQueryOnly.TemplateLookup.ReadModelHoles+    StructuralNominalLeaves.ProjectionCatalog.ProjectionCatalogHoles+    StructuralNominalLeaves.TemplateCatalog.BehaviorHoles+    StructuralNominalLeaves.TemplateLookup.ReadModelHoles++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    directory >=1.3 && <1.4,+    effectful-core,+    filepath >=1.4 && <1.6,+    hasql-transaction,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-core,+    keiro-dsl,+    keiro-pgmq,+    kiroku-store,+    mmzk-typeid >=0.7 && <0.8,+    shibuya-core,+    text >=2.1 && <2.2,++-- Plan 224: candidate language-5 mapped workqueue payloads share structural+-- codec authority while preserving the queue schema-version-1 envelope.+test-suite keiro-dsl-conformance-mapped-queue+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-mapped-queue+  main-is: Main.hs+  other-modules:+    Conformance.MappedQueue.Bindings+    Conformance.MappedQueue.Domain+    Generated.MappedQueue.MappedJobs.Queue+    Generated.MappedQueue.MappedJobs.QueueCodec+    Generated.MappedQueue.MappedJobs.QueuePolicy+    Generated.MappedQueue.Structural.Shape.JobMetadata+    Generated.MappedQueue.Structural.Shape.JobPayload+    Generated.MappedQueue.StructuralConformance+    Generated.MappedQueue.StructuralProjections++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-core,+    keiro-dsl,+    keiro-pgmq,+    text >=2.1 && <2.2,++-- Plan 225: candidate language-5 read-model input/result expressions lower to+-- generated mapped domain aliases while SQL and query bodies remain hand-owned.+test-suite keiro-dsl-conformance-mapped-readmodel+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-mapped-readmodel+  main-is: Main.hs+  other-modules:+    Conformance.MappedReadModel.Bindings+    Conformance.MappedReadModel.Domain+    Generated.MappedReadmodel.AccountSummary.QueryContract+    Generated.MappedReadmodel.AccountSummary.ReadModel+    Generated.MappedReadmodel.AccountSummary.ReadModelHarness+    Generated.MappedReadmodel.AccountSummary.ReadModelTable+    Generated.MappedReadmodel.ProjectionCatalog+    Generated.MappedReadmodel.Structural.Shape.AccountLookup+    Generated.MappedReadmodel.Structural.Shape.AccountProfile+    Generated.MappedReadmodel.Structural.Shape.AccountSummary+    Generated.MappedReadmodel.Structural.Shape.TenantKey+    Generated.MappedReadmodel.Structural.Shape.UnusedFilter+    Generated.MappedReadmodel.StructuralConformance+    Generated.MappedReadmodel.StructuralProjections+    MappedReadmodel.AccountSummary.ReadModelHoles+    MappedReadmodel.ProjectionCatalog.ProjectionCatalogHoles++  build-depends:+    base >=4.21 && <5,+    effectful-core,+    hasql-transaction,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-dsl,+    kiroku-store,+    text >=2.1 && <2.2,++-- Plan 184: colliding consumer type occurrences, local-name conflicts, and+-- repeated binding/shape references compile with deterministic short aliases.+test-suite keiro-dsl-conformance-import-planning+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-import-planning+  main-is: Main.hs+  other-modules:+    Generated.ImportPlanningCollisions.BehaviorSourceMap+    Generated.ImportPlanningCollisions.CollisionLedger.BehaviorContract+    Generated.ImportPlanningCollisions.CollisionLedger.Codec+    Generated.ImportPlanningCollisions.CollisionLedger.Domain+    Generated.ImportPlanningCollisions.CollisionLedger.EventStream+    Generated.ImportPlanningCollisions.CollisionLedger.Harness+    Generated.ImportPlanningCollisions.CollisionLedger.Projection+    Generated.ImportPlanningCollisions.CollisionLedger.Transducer+    Generated.ImportPlanningCollisions.NominalProjections+    Generated.ImportPlanningCollisions.ReplayAudit+    Generated.ImportPlanningCollisions.Structural.Shape.Details+    Generated.ImportPlanningCollisions.StructuralConformance+    Generated.ImportPlanningCollisions.StructuralProjections+    ImportPlanning.Bindings+    ImportPlanning.Consumer.Domain+    ImportPlanning.Consumer.Invoice.Types+    ImportPlanning.Consumer.Order.Types+    ImportPlanning.Consumer.Shared.Types+    ImportPlanningCollisions.CollisionLedger.BehaviorHoles++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.12 && <0.13,+    containers >=0.6 && <0.8,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,++-- Plan 152 / Experiment B: a consumer-owned historical codec and finite JSON+-- corpus compared with the generated structural codec. The comparison module+-- is opt-in tooling output and is not part of the production scaffold record.+test-suite keiro-dsl-conformance-codec-compare+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs:+    test/conformance-codec-compare+    test/conformance-structural++  main-is: Main.hs+  other-modules:+    Conformance.CodecCompare.Historical+    Conformance.Structural.Bindings+    Conformance.Structural.Domain+    Generated.StructuralConformance.ArtifactCatalog.Codec+    Generated.StructuralConformance.ArtifactCatalog.Domain+    Generated.StructuralConformance.Structural.CodecCompare.ArtifactInfo+    Generated.StructuralConformance.Structural.Shape.ArtifactInfo+    Generated.StructuralConformance.Structural.Shape.ArtifactKind+    Generated.StructuralConformance.Structural.Shape.ArtifactLocation+    Generated.StructuralConformance.Structural.Shape.ArtifactMetadata++  build-depends:+    aeson >=2.2.1 && <2.3,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    deepseq >=1.5 && <1.6,+    directory >=1.3 && <1.4,+    filepath >=1.4 && <1.6,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-dsl,+    text >=2.1 && <2.2,++-- Plan 147 M2: a dedicated honest-wire baseline plus a dormant idempotent+-- dishonest WireCtor used by replay-mutation-test.sh to prove that generated+-- forward/replay register comparisons catch state divergence missed by the+-- pre-existing validator, codec round-trip, and accept assertions.+test-suite keiro-dsl-conformance-replay+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-replay+  main-is: Main.hs+  other-modules:+    Generated.ReplayDivergence.BehaviorSourceMap+    Generated.ReplayDivergence.Note.Codec+    Generated.ReplayDivergence.Note.Domain+    Generated.ReplayDivergence.Note.EventStream+    Generated.ReplayDivergence.Note.Harness+    Generated.ReplayDivergence.Note.Projection+    Generated.ReplayDivergence.Note.Transducer+    Generated.ReplayDivergence.ReplayAudit+    ReplayDivergence.Note.Holes++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,++benchmark keiro-dsl-codec-bench+  import: warnings, shared+  type: exitcode-stdio-1.0+  hs-source-dirs:+    bench/structural-codec+    test/conformance-structural++  main-is: Main.hs+  other-modules:+    Conformance.Structural.Bindings+    Conformance.Structural.Domain+    Generated.StructuralConformance.ArtifactCatalog.Codec+    Generated.StructuralConformance.ArtifactCatalog.Domain+    Generated.StructuralConformance.Structural.Shape.ArtifactInfo+    Generated.StructuralConformance.Structural.Shape.ArtifactKind+    Generated.StructuralConformance.Structural.Shape.ArtifactLocation+    Generated.StructuralConformance.Structural.Shape.ArtifactMetadata++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    deepseq >=1.5 && <1.6,+    keiki >=0.9 && <0.10,+    keiro ^>=0.17.0.0,+    tasty-bench >=0.5 && <0.6,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,++benchmark keiro-dsl-parser-bench+  import: warnings, shared+  type: exitcode-stdio-1.0+  hs-source-dirs: bench/parser-scaling+  main-is: Main.hs+  build-depends:+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    deepseq >=1.5 && <1.6,+    keiro-dsl,+    tasty-bench >=0.5 && <0.6,+    text >=2.1 && <2.2,++benchmark process-scaling+  import: warnings, shared+  type: exitcode-stdio-1.0+  hs-source-dirs: bench/process-scaling+  main-is: Main.hs+  build-depends:+    base >=4.21 && <5,+    keiro-dsl,+    tasty-bench >=0.5 && <0.6,+    text >=2.1 && <2.2,++-- EP-109 M2: snapshot-enabled aggregate scaffolding compiled against the live+-- defaultStateCodec and stream-construction guards, with the captured codec+-- identity checked against keiki's regFileShapeHash.+test-suite keiro-dsl-conformance-snapshot+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-snapshot+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.BehaviorSourceMap+    Generated.HospitalCapacity.Nominals+    Generated.HospitalCapacity.Nominals.Internal+    Generated.HospitalCapacity.ReplayAudit+    Generated.HospitalCapacity.Reservation.Codec+    Generated.HospitalCapacity.Reservation.Domain+    Generated.HospitalCapacity.Reservation.EventStream+    Generated.HospitalCapacity.Reservation.Transducer+    HospitalCapacity.Reservation.Holes++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,++-- EP-106 M6: every distinct `new <kind>` skeleton is scaffolded into this+-- committed tree. Compiling the union proves a starter that passes `check`+-- cannot emit syntactically or type-invalid Haskell.+-- The only corpus suite whose hole modules are deliberately *unfilled*: it+-- exists to prove `keiro-dsl new <kind>` scaffolds a skeleton that compiles, so+-- its create-once files still carry their `-- HOLE` markers. A template cannot+-- be clean under -Wunused-imports/-Wunused-matches by construction — its imports+-- and its command binder are there for the fill that has not happened yet — so+-- those two classes are non-fatal here and everywhere-else-fatal. Every other+-- warning class remains an error, and the generated modules in this suite are+-- held to the same standard as the rest of the corpus.+test-suite keiro-dsl-conformance-skeletons+  import: warnings, generated-output+  ghc-options:+    -Wno-error=unused-imports+    -Wno-error=unused-matches++  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-skeletons+  main-is: Main.hs+  other-modules:+    SkelAggregate.Generated.MyService.Nominals+    SkelAggregate.Generated.MyService.Nominals.Internal+    SkelAggregate.Generated.MyService.ReplayAudit+    SkelAggregate.Generated.MyService.Thing.BehaviorContract+    SkelAggregate.Generated.MyService.Thing.Codec+    SkelAggregate.Generated.MyService.Thing.Domain+    SkelAggregate.Generated.MyService.Thing.EventStream+    SkelAggregate.Generated.MyService.Thing.Harness+    SkelAggregate.Generated.MyService.Thing.Projection+    SkelAggregate.Generated.MyService.Thing.Transducer+    SkelAggregate.MyService.Thing.BehaviorHoles+    SkelAggregate.MyService.Thing.Holes+    SkelContract.Generated.MyService.MyContract.Contract+    SkelEmit.Generated.MyService.MyContract.Contract+    SkelEmit.Generated.MyService.ThingPublisher.Publisher+    SkelIntake.Generated.MyService.MyContract.Contract+    SkelIntake.Generated.MyService.ThingInbox.Inbox+    SkelProcess.Generated.MyService.Hospital.Codec+    SkelProcess.Generated.MyService.Hospital.Domain+    SkelProcess.Generated.MyService.Hospital.EventStream+    SkelProcess.Generated.MyService.Hospital.Harness+    SkelProcess.Generated.MyService.Hospital.Projection+    SkelProcess.Generated.MyService.Hospital.Transducer+    SkelProcess.Generated.MyService.HospitalSurge.Process+    SkelProcess.Generated.MyService.HospitalSurge.ProcessHarness+    SkelProcess.Generated.MyService.Nominals+    SkelProcess.Generated.MyService.Nominals.Internal+    SkelProcess.Generated.MyService.ReplayAudit+    SkelProcess.Generated.MyService.Surge.Codec+    SkelProcess.Generated.MyService.Surge.Domain+    SkelProcess.Generated.MyService.Surge.EventStream+    SkelProcess.Generated.MyService.Surge.Harness+    SkelProcess.Generated.MyService.Surge.Projection+    SkelProcess.Generated.MyService.Surge.Transducer+    SkelProcess.MyService.Hospital.Holes+    SkelProcess.MyService.HospitalSurge.ProcessHoles+    SkelProcess.MyService.Surge.Holes+    SkelQueue.Generated.MyService.AcceptedTransferNeeds.ReadModel+    SkelQueue.Generated.MyService.AcceptedTransferNeeds.ReadModelHarness+    SkelQueue.Generated.MyService.AcceptedTransferNeeds.ReadModelTable+    SkelQueue.Generated.MyService.ReservationWork.Queue+    SkelQueue.Generated.MyService.ReservationWork.QueueCodec+    SkelQueue.Generated.MyService.ReservationWork.QueuePolicy+    SkelQueue.Generated.MyService.TransferDecisions.ReadModel+    SkelQueue.Generated.MyService.TransferDecisions.ReadModelHarness+    SkelQueue.Generated.MyService.TransferDecisions.ReadModelTable+    SkelQueue.MyService.AcceptedTransferNeeds.ReadModelHoles+    SkelQueue.MyService.TransferDecisions.ReadModelHoles+    SkelRouter.Generated.MyService.Page.Codec+    SkelRouter.Generated.MyService.Page.Domain+    SkelRouter.Generated.MyService.Page.EventStream+    SkelRouter.Generated.MyService.Page.Harness+    SkelRouter.Generated.MyService.Page.Projection+    SkelRouter.Generated.MyService.Page.Transducer+    SkelRouter.Generated.MyService.PagingRouter.Router+    SkelRouter.Generated.MyService.PagingRouter.RouterHarness+    SkelRouter.Generated.MyService.ReplayAudit+    SkelRouter.MyService.Page.Holes+    SkelRouter.MyService.PagingRouter.RouterHoles+    SkelWorkflow.Generated.MyService.HospitalTransferReservation.WorkflowFacts+    SkelWorkflow.Generated.MyService.HospitalTransferReservation.WorkflowRuntime++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers,+    effectful-core,+    hasql-transaction,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-core,+    keiro-pgmq,+    kiroku-store,+    mmzk-typeid >=0.7 && <0.8,+    shibuya-core,+    text >=2.1 && <2.2,+    time,+    uuid,++-- EP-7 cold-start: a fresh `subscription` aggregate authored from only the skill+-- notation, scaffolded + hand-filled, compiling against keiki/keiro with a green+-- spec-derived harness — proof the authoring loop closes on a non-corpus spec.+test-suite keiro-dsl-conformance-coldstart+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-coldstart+  main-is: Main.hs+  other-modules:+    Billing.Subscription.Holes+    Generated.Billing.BehaviorSourceMap+    Generated.Billing.Nominals+    Generated.Billing.Nominals.Internal+    Generated.Billing.ReplayAudit+    Generated.Billing.Subscription.Codec+    Generated.Billing.Subscription.Domain+    Generated.Billing.Subscription.EventStream+    Generated.Billing.Subscription.Harness+    Generated.Billing.Subscription.Projection+    Generated.Billing.Subscription.Transducer++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,++-- Stable language-4 contract conformance: prefix-indexed KindID fields,+-- canonical text JSON, field-path-aware rejection, and the complete generated+-- dependency set.+test-suite keiro-dsl-conformance-contract+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-contract+  main-is: Main.hs+  other-modules: Generated.HospitalCapacity.Emergency.Contract+  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiro-core,+    mmzk-typeid >=0.7 && <0.8,+    text >=2.1 && <2.2,++-- Plan 288: candidate-language contracts reuse declared generated and+-- consumer-bound IDs while preserving canonical TypeID JSON admission.+test-suite keiro-dsl-conformance-contract-declared-id+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-contract-declared-id+  main-is: Main.hs+  other-modules:+    Conformance.ContractDeclaredId.Bindings+    Conformance.ContractDeclaredId.Domain+    Generated.ContractDeclaredId.Nominals+    Generated.ContractDeclaredId.Nominals.Internal+    Generated.ContractDeclaredId.Structural.NominalLeaves+    Generated.ContractDeclaredId.StructuralConformance+    Generated.ContractDeclaredId.Templates.Contract++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-core,+    keiro-dsl,+    mmzk-typeid >=0.7 && <0.8,+    text >=2.1 && <2.2,++-- Language-1 compatibility proof: the historical permissive Text contract DTO+-- still accepts pre-TypeID-v7 samples and retains its released JSON image.+test-suite keiro-dsl-conformance-contract-v1-compat+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-contract-v1-compat+  main-is: Main.hs+  other-modules: Generated.HospitalCapacity.Emergency.Contract+  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.12 && <0.13,+    text >=2.1 && <2.2,++-- EP-4 intake runtime conformance: the scaffolded Inbox disposition + dedupe+-- policy compiled against the LIVE Keiro.Inbox.Types (InboxResult / dedupe).+test-suite keiro-dsl-conformance-intake-runtime+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-intake-runtime+  main-is: Main.hs+  other-modules: Generated.HospitalCapacity.IncidentInbox.Inbox+  build-depends:+    base >=4.21 && <5,+    keiro,+    text >=2.1 && <2.2,++-- Candidate Language 6 delegated intake: generated no-Store runner plus a+-- hand-filled integration wrapper compiled and executed against the live API.+test-suite keiro-dsl-conformance-intake-delegated+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-intake-delegated+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.Emergency.Contract+    Generated.HospitalCapacity.IncidentInbox.Inbox+    HospitalCapacity.IncidentInbox.DelegatedIntegration++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    effectful-core,+    keiro,+    keiro-core,+    mmzk-typeid >=0.7 && <0.8,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,++-- EP-4 M5 full-service conformance: a complete integration service — scaffolded+-- inbox dedupe + a filled inbox transaction runner and outbox IntegrationProducer+-- — compiled against the live keiro runtime (Inbox / Outbox / Kiroku.Store).+test-suite keiro-dsl-conformance-intake-full+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-intake-full+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.IncidentInbox.Inbox+    HospitalCapacity.IncidentInbox.Integration++  build-depends:+    base >=4.21 && <5,+    effectful-core,+    hasql-transaction,+    keiro,+    kiroku-store >=0.8 && <0.9,+    text >=2.1 && <2.2,++-- EP-4 publisher runtime conformance: the scaffolded Publisher config compiled+-- against the LIVE Keiro.Outbox.Types (OrderingPolicy / BackoffSchedule).+test-suite keiro-dsl-conformance-publisher-runtime+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-publisher-runtime+  main-is: Main.hs+  other-modules: Generated.HospitalCapacity.HospitalPublisher.Publisher+  build-depends:+    base >=4.21 && <5,+    keiro,++-- pgmq Job codec conformance (EP-5): the scaffolded self-contained Job payload+-- record + field->wire codec, compiled + round-tripped.+test-suite keiro-dsl-conformance-queue+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-queue+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.ReservationWork.Queue+    Generated.HospitalCapacity.ReservationWork.QueueCodec++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiro-core,+    keiro-pgmq,+    text >=2.1 && <2.2,++-- EP-5 pgmq runtime conformance: the scaffolded QueuePolicy (RetryPolicy ++-- JobOutcome disposition) compiled against the LIVE Keiro.PGMQ.Job runtime.+test-suite keiro-dsl-conformance-queue-runtime+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-queue-runtime+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.ReservationWork.Queue+    Generated.HospitalCapacity.ReservationWork.QueueCodec+    Generated.HospitalCapacity.ReservationWork.QueuePolicy++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.12 && <0.13,+    keiro-core,+    keiro-dsl,+    keiro-pgmq,+    pgmq-config,+    pgmq-core,+    text >=2.1 && <2.2,++-- EP-107 read-model runtime conformance: the scaffolded ReadModel record,+-- registration/rebuild helpers, AsyncProjection, facts harness, and a filled+-- qualified-table query compiled against the live Keiro.ReadModel API.+test-suite keiro-dsl-conformance-readmodel-runtime+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-readmodel-runtime+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.TransferDecisions.ReadModel+    Generated.HospitalCapacity.TransferDecisions.ReadModelHarness+    Generated.HospitalCapacity.TransferDecisions.ReadModelTable+    HospitalCapacity.TransferDecisions.ReadModelHoles++  build-depends:+    base >=4.21 && <5,+    effectful-core,+    hasql-transaction,+    keiro,+    kiroku-store,+    text >=2.1 && <2.2,++-- MasterPlan 32 / EP-4: language-5 catalog declarations lower into one+-- generated runtime-owned facade with typed inline views, catalog-derived+-- async/query registration, and a group-scoped history-runner entry point.+test-suite keiro-dsl-conformance-projection-catalog+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-projection-catalog+  main-is: Main.hs+  other-modules:+    CatalogDemo.CatalogAudit.ReadModelHoles+    CatalogDemo.MappedBindings+    CatalogDemo.MappedDomain+    CatalogDemo.OrderInline.ReadModelHoles+    CatalogDemo.OrderTotalsLookup.ReadModelHoles+    CatalogDemo.Orders.BehaviorHoles+    CatalogDemo.Orders.Holes+    CatalogDemo.ProjectionCatalog.ProjectionCatalogHoles+    CatalogDemo.ShipmentLookup.ReadModelHoles+    CatalogDemo.Shipments.BehaviorHoles+    Generated.CatalogDemo.BehaviorSourceMap+    Generated.CatalogDemo.CatalogAudit.ReadModel+    Generated.CatalogDemo.CatalogAudit.ReadModelHarness+    Generated.CatalogDemo.CatalogAudit.ReadModelTable+    Generated.CatalogDemo.OrderInline.QueryContract+    Generated.CatalogDemo.OrderInline.ReadModel+    Generated.CatalogDemo.OrderInline.ReadModelHarness+    Generated.CatalogDemo.OrderInline.ReadModelTable+    Generated.CatalogDemo.OrderTotalsLookup.ReadModel+    Generated.CatalogDemo.OrderTotalsLookup.ReadModelHarness+    Generated.CatalogDemo.OrderTotalsLookup.ReadModelTable+    Generated.CatalogDemo.Orders.BehaviorContract+    Generated.CatalogDemo.Orders.Codec+    Generated.CatalogDemo.Orders.Domain+    Generated.CatalogDemo.Orders.EventStream+    Generated.CatalogDemo.Orders.Harness+    Generated.CatalogDemo.Orders.Projection+    Generated.CatalogDemo.Orders.Transducer+    Generated.CatalogDemo.ProjectionCatalog+    Generated.CatalogDemo.QualificationJobs.Queue+    Generated.CatalogDemo.QualificationJobs.QueueCodec+    Generated.CatalogDemo.QualificationJobs.QueuePolicy+    Generated.CatalogDemo.ReplayAudit+    Generated.CatalogDemo.ShipmentLookup.ReadModel+    Generated.CatalogDemo.ShipmentLookup.ReadModelHarness+    Generated.CatalogDemo.ShipmentLookup.ReadModelTable+    Generated.CatalogDemo.Shipments.BehaviorContract+    Generated.CatalogDemo.Shipments.Codec+    Generated.CatalogDemo.Shipments.Domain+    Generated.CatalogDemo.Shipments.EventStream+    Generated.CatalogDemo.Shipments.Harness+    Generated.CatalogDemo.Shipments.Projection+    Generated.CatalogDemo.Shipments.Transducer+    Generated.CatalogDemo.Structural.Shape.QualificationPayload+    Generated.CatalogDemo.StructuralConformance+    Generated.CatalogDemo.StructuralProjections++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers >=0.6 && <0.8,+    effectful-core,+    hasql-transaction,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-core,+    keiro-dsl,+    keiro-pgmq,+    kiroku-store,+    text >=2.1 && <2.2,++-- EP-5 M5 full-service conformance: a complete pgmq dispatch service — scaffolded+-- Job codec + retry policy + a filled worker handler assembled into a live+-- Keiro.PGMQ.Job.Job value — compiled against keiro-pgmq.+test-suite keiro-dsl-conformance-dispatch-full+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-dispatch-full+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.ReservationWork.Queue+    Generated.HospitalCapacity.ReservationWork.QueueCodec+    Generated.HospitalCapacity.ReservationWork.QueuePolicy+    HospitalCapacity.ReservationWork.WorkqueueJob++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    effectful-core,+    keiro-core,+    keiro-pgmq,+    text >=2.1 && <2.2,++-- Workflow facts harness (EP-6): the scaffolded self-contained WorkflowFacts+-- module asserted against a hand-written expectation (mutation-pinnable).+test-suite keiro-dsl-conformance-workflow+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-workflow+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.HospitalTransferReservation.WorkflowFacts++  build-depends: base >=4.21 && <5++-- Workflow runtime conformance: the scaffolded WorkflowRuntime allocates its+-- declared await through the live Keiro.Workflow effect and exercises the+-- returned opaque id against PostgreSQL.+test-suite keiro-dsl-conformance-workflow-runtime+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-workflow-runtime+  main-is: Main.hs+  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N++  other-modules:+    Generated.HospitalCapacity.HospitalTransferReservation.WorkflowRuntime++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers,+    effectful-core,+    keiro,+    keiro-test-support,+    kiroku-store,+    text >=2.1 && <2.2,++-- EP-3 M5 full-service conformance: a complete process service — the scaffolded+-- Surge (saga) + Hospital (target) aggregates with filled transducers, plus a+-- filled ProcessManager handle — compiled against the live keiro/keiki runtime.+test-suite keiro-dsl-conformance-process-full+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-process-full+  main-is: Main.hs+  other-modules:+    Generated.SurgeDemo.BehaviorSourceMap+    Generated.SurgeDemo.Hospital.Codec+    Generated.SurgeDemo.Hospital.Domain+    Generated.SurgeDemo.Hospital.EventStream+    Generated.SurgeDemo.Hospital.Projection+    Generated.SurgeDemo.Hospital.Transducer+    Generated.SurgeDemo.Nominals+    Generated.SurgeDemo.Nominals.Internal+    Generated.SurgeDemo.ReplayAudit+    Generated.SurgeDemo.Surge.Codec+    Generated.SurgeDemo.Surge.Domain+    Generated.SurgeDemo.Surge.EventStream+    Generated.SurgeDemo.Surge.Projection+    Generated.SurgeDemo.Surge.Transducer+    Generated.SurgeDemo.SurgeFlow.Process+    SurgeDemo.Hospital.Holes+    SurgeDemo.Surge.Holes+    SurgeDemo.SurgeFlow.Manager++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro,+    shibuya-core,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,+    uuid >=1.3 && <1.4,++-- EP-6 M5 full-service conformance: a complete durable workflow — scaffolded+-- WorkflowRuntime + a filled ordered step/await body — compiled against the+-- live Keiro.Workflow effect.+test-suite keiro-dsl-conformance-workflow-full+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-workflow-full+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.HospitalTransferReservation.WorkflowRuntime+    HospitalCapacity.HospitalTransferReservation.WorkflowBody++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    containers,+    effectful-core,+    keiro,+    kiroku-store,+    text >=2.1 && <2.2,++-- EP-3 process runtime conformance: the scaffolded Process module's+-- deterministic wiring (timer-request builder + fire disposition) compiled+-- against the LIVE keiro runtime (Keiro.Timer / Keiro.Command), not just text.+test-suite keiro-dsl-conformance-process-runtime+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-process-runtime+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.BehaviorSourceMap+    Generated.HospitalCapacity.HospitalSurge.Process+    Generated.HospitalCapacity.Nominals+    Generated.HospitalCapacity.Nominals.Internal+    Generated.HospitalCapacity.Surge.Codec+    Generated.HospitalCapacity.Surge.Domain+    Generated.HospitalCapacity.Surge.EventStream+    Generated.HospitalCapacity.Surge.Transducer+    HospitalCapacity.Surge.Holes++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-dsl,+    shibuya-core,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,+    uuid >=1.3 && <1.4,++-- Language 6 first-class process reactions: the generated typed input,+-- declarative reaction and public runtime manager compile together.+test-suite keiro-dsl-conformance-process-reactions+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-process-reactions+  main-is: Main.hs+  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N++  other-modules:+    Generated.ProcessReactions.AuditOnly.Input+    Generated.ProcessReactions.AuditOnly.Process+    Generated.ProcessReactions.Incident.Codec+    Generated.ProcessReactions.Incident.Domain+    Generated.ProcessReactions.Incident.EventStream+    Generated.ProcessReactions.Incident.Transducer+    Generated.ProcessReactions.IncidentReaction.Input+    Generated.ProcessReactions.IncidentReaction.Process+    Generated.ProcessReactions.IncidentSaga.Codec+    Generated.ProcessReactions.IncidentSaga.Domain+    Generated.ProcessReactions.IncidentSaga.EventStream+    Generated.ProcessReactions.IncidentSaga.Transducer+    Generated.ProcessReactions.Nominals+    Generated.ProcessReactions.Nominals.Internal+    Generated.ProcessReactions.ScalingReaction.Input+    Generated.ProcessReactions.ScalingReaction.Process+    Generated.ProcessReactions.ScalingReaction.ProcessHarness+    ProcessReactions.AuditOnly.ProcessHoles+    ProcessReactions.IncidentReaction.ProcessHoles+    ProcessReactions.ScalingReaction.ProcessHoles++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    effectful-core,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-test-support,+    kiroku-store >=0.8 && <0.9,+    shibuya-core,+    streamly-core >=0.3 && <0.4,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,+    uuid >=1.3 && <1.4,+    vector >=0.13 && <0.14,++-- Language 6 reaction timers: typed payload codecs, schedule modes,+-- cancellation accounting and deterministic fire redelivery.+test-suite keiro-dsl-conformance-process-timers+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-process-timers+  main-is: Main.hs+  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N++  other-modules:+    Generated.ProcessTimers.Incident.Codec+    Generated.ProcessTimers.Incident.Domain+    Generated.ProcessTimers.Incident.EventStream+    Generated.ProcessTimers.Incident.Transducer+    Generated.ProcessTimers.IncidentSaga.Codec+    Generated.ProcessTimers.IncidentSaga.Domain+    Generated.ProcessTimers.IncidentSaga.EventStream+    Generated.ProcessTimers.IncidentSaga.Transducer+    Generated.ProcessTimers.IncidentTimers.Input+    Generated.ProcessTimers.IncidentTimers.Process+    Generated.ProcessTimers.Nominals+    Generated.ProcessTimers.Nominals.Internal+    ProcessTimers.IncidentTimers.ProcessHoles++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.12 && <0.13,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-test-support,+    kiroku-store >=0.8 && <0.9,+    shibuya-core,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,+    uuid >=1.3 && <1.4,+    vector >=0.13 && <0.14,++-- Language 6 reaction state authority: saga acceptance owns accepted-only+-- fan-out, while redelivery completes only missing deterministic target writes.+test-suite keiro-dsl-conformance-process-state-authority+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-process-state-authority+  main-is: Main.hs+  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N++  other-modules:+    Generated.IncidentResponse.Escalation.Codec+    Generated.IncidentResponse.Escalation.Domain+    Generated.IncidentResponse.Escalation.EventStream+    Generated.IncidentResponse.Escalation.Transducer+    Generated.IncidentResponse.Incident.Codec+    Generated.IncidentResponse.Incident.Domain+    Generated.IncidentResponse.Incident.EventStream+    Generated.IncidentResponse.Incident.Transducer+    Generated.IncidentResponse.IncidentEscalation.Input+    Generated.IncidentResponse.IncidentEscalation.Process+    Generated.IncidentResponse.Nominals+    Generated.IncidentResponse.Nominals.Internal+    IncidentResponse.IncidentEscalation.ProcessHoles++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.12 && <0.13,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-test-support,+    kiroku-store >=0.8 && <0.9,+    shibuya-core,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,+    uuid >=1.3 && <1.4,+    vector >=0.13 && <0.14,++-- EP-108 router runtime conformance: generated policy lowering and the live+-- target-keyed deterministic id contract.+test-suite keiro-dsl-conformance-router-runtime+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-router-runtime+  main-is: Main.hs+  other-modules:+    Generated.IncidentPaging.BehaviorSourceMap+    Generated.IncidentPaging.PagingRouter.Router+    Generated.IncidentPaging.PagingRouter.RouterHarness++  build-depends:+    base >=4.21 && <5,+    keiro,+    kiroku-store,+    shibuya-core,+    text >=2.1 && <2.2,+    uuid >=1.3 && <1.4,++-- Plan 230: the checked language-5 selection is generated, compiled against+-- the public runtime, and exercised through a real read-model query and ledger.+test-suite keiro-dsl-conformance-declarative-router+  import: generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-declarative-router+  main-is: Main.hs+  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N++  other-modules:+    Conformance.DeclarativeRouter.Bindings+    Conformance.DeclarativeRouter.Domain+    Generated.TransferRouting.BehaviorSourceMap+    Generated.TransferRouting.Hospital.BehaviorContract+    Generated.TransferRouting.Hospital.Codec+    Generated.TransferRouting.Hospital.Domain+    Generated.TransferRouting.Hospital.EventStream+    Generated.TransferRouting.Hospital.Harness+    Generated.TransferRouting.Hospital.Projection+    Generated.TransferRouting.Hospital.Transducer+    Generated.TransferRouting.HospitalLoad.QueryContract+    Generated.TransferRouting.HospitalLoad.ReadModel+    Generated.TransferRouting.HospitalLoad.ReadModelHarness+    Generated.TransferRouting.HospitalLoad.ReadModelTable+    Generated.TransferRouting.HospitalTransferRouter.Router+    Generated.TransferRouting.HospitalTransferRouter.RouterHarness+    Generated.TransferRouting.ProjectionCatalog+    Generated.TransferRouting.ReplayAudit+    Generated.TransferRouting.Structural.Shape.HospitalLoadRow+    Generated.TransferRouting.Structural.Shape.TransferRouteInput+    Generated.TransferRouting.StructuralConformance+    Generated.TransferRouting.StructuralProjections+    TransferRouting.Hospital.BehaviorHoles+    TransferRouting.HospitalLoad.ReadModelHoles+    TransferRouting.ProjectionCatalog.ProjectionCatalogHoles++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    bytestring >=0.11 && <0.13,+    containers >=0.6 && <0.8,+    effectful-core,+    hasql >=1.10 && <1.11,+    hasql-transaction >=1.1 && <1.3,+    keiki >=0.9 && <0.10,+    keiro,+    keiro-dsl,+    keiro-test-support,+    kiroku-store >=0.8 && <0.9,+    shibuya-core ^>=0.9.0.0,+    text >=2.1 && <2.2,+    time >=1.12 && <1.15,+    uuid >=1.3 && <1.4,+    vector >=0.13 && <0.14,++-- EP-108 generated router-facts harness with hand-written expectations.+test-suite keiro-dsl-conformance-router+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-router+  main-is: Main.hs+  other-modules:+    Generated.IncidentPaging.BehaviorSourceMap+    Generated.IncidentPaging.PagingRouter.RouterHarness++  build-depends:+    base >=4.21 && <5,+    text >=2.1 && <2.2,++-- EP-108 filled-router conformance: scaffolded Page aggregate plus a filled+-- resolver and Router value compiled against the live API.+test-suite keiro-dsl-conformance-router-full+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-router-full+  main-is: Main.hs+  other-modules:+    Generated.IncidentPaging.BehaviorSourceMap+    Generated.IncidentPaging.Page.Codec+    Generated.IncidentPaging.Page.Domain+    Generated.IncidentPaging.Page.EventStream+    Generated.IncidentPaging.Page.Transducer+    Generated.IncidentPaging.PagingRouter.Router+    Generated.IncidentPaging.PagingRouter.RouterHarness+    Generated.IncidentPaging.ReplayAudit+    IncidentPaging.Page.Holes+    IncidentPaging.PagingRouter.RouterValue++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    effectful-core,+    keiki >=0.9 && <0.10,+    keiro,+    shibuya-core,+    text >=2.1 && <2.2,++-- MP-15/EP-110 M6 cold-start: a fresh agent, given only the authoring skill+-- and feature sentence, produced this aggregate + readmodel + router service.+-- The component compiles generated output and hand-owned fills together and+-- runs the aggregate, readmodel, router-policy, and live Router assertions.+test-suite keiro-dsl-conformance-newsurface+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-newsurface+  main-is: Main.hs+  other-modules:+    Generated.TransferRouting.BehaviorSourceMap+    Generated.TransferRouting.Conformance+    Generated.TransferRouting.Hospital.Codec+    Generated.TransferRouting.Hospital.Domain+    Generated.TransferRouting.Hospital.EventStream+    Generated.TransferRouting.Hospital.Harness+    Generated.TransferRouting.Hospital.Projection+    Generated.TransferRouting.Hospital.Transducer+    Generated.TransferRouting.HospitalLoad.ReadModel+    Generated.TransferRouting.HospitalLoad.ReadModelHarness+    Generated.TransferRouting.HospitalLoad.ReadModelTable+    Generated.TransferRouting.HospitalTransferRouter.Router+    Generated.TransferRouting.HospitalTransferRouter.RouterHarness+    Generated.TransferRouting.ReplayAudit+    TransferRouting.Hospital.Holes+    TransferRouting.HospitalLoad.ReadModelHoles+    TransferRouting.HospitalTransferRouter.RouterHoles+    TransferRouting.HospitalTransferRouter.RouterValue++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    effectful-core,+    hasql-transaction,+    keiki >=0.9 && <0.10,+    keiro,+    kiroku-store,+    shibuya-core,+    text >=2.1 && <2.2,++-- Process-manager facts harness (EP-3 M4): the self-contained, firewall-clean+-- ProcessHarness module scaffolded from hospital-surge.keiro, compiled + run to+-- prove the scaffolder lowered the spec's deterministic process/timer decisions+-- faithfully. (The runtime-coupled Process/ProcessHoles modules are emitted to+-- disk but not in this component; their live conformance is the M5 step.)+test-suite keiro-dsl-conformance-process+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-process+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.BehaviorSourceMap+    Generated.HospitalCapacity.HospitalSurge.ProcessHarness++  build-depends:+    base >=4.21 && <5,+    text >=2.1 && <2.2,++-- Conformance for the evolved (v2) Reservation aggregate: proves the scaffolded+-- Codec schemaVersion=2 + upcasters wiring compiles and that the filled upcaster+-- migrates a v1-tagged payload through the chain (the harness "upcaster wired"+-- assertion). These sources are raw `keiro-dsl scaffold` output of+-- reservation-v2.keiro plus a hand-filled Holes.hs.+test-suite keiro-dsl-conformance-v2+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-v2+  main-is: Main.hs+  other-modules:+    Generated.HospitalCapacity.BehaviorSourceMap+    Generated.HospitalCapacity.Nominals+    Generated.HospitalCapacity.Nominals.Internal+    Generated.HospitalCapacity.ReplayAudit+    Generated.HospitalCapacity.Reservation.Codec+    Generated.HospitalCapacity.Reservation.Domain+    Generated.HospitalCapacity.Reservation.EventStream+    Generated.HospitalCapacity.Reservation.Harness+    Generated.HospitalCapacity.Reservation.Projection+    Generated.HospitalCapacity.Reservation.Transducer+    HospitalCapacity.Reservation.Holes++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    directory >=1.3 && <1.4,+    keiki >=0.9 && <0.10,+    keiro,+    text >=2.1 && <2.2,++-- IR-14 / EP-171 migration conformance. The generated v3 public ID surface+-- rejects malformed current input while its explicitly internal event-replay+-- seam preserves identical malformed text from a legacy payload.+test-suite keiro-dsl-conformance-id-domain-migration+  import: warnings, generated-output+  type: exitcode-stdio-1.0+  hs-source-dirs: test/conformance-id-domain-migration+  main-is: Main.hs+  other-modules:+    Generated.IdDomainMigration.BehaviorSourceMap+    Generated.IdDomainMigration.Nominals+    Generated.IdDomainMigration.Nominals.Internal+    Generated.IdDomainMigration.OrderBook.Codec+    Generated.IdDomainMigration.OrderBook.Domain++  build-depends:+    aeson >=2.2 && <2.3,+    base >=4.21 && <5,+    keiki >=0.9 && <0.10,+    keiro-core,+    text >=2.1 && <2.2,
record-field-migration-0.15.md view
@@ -9,1338 +9,1458 @@ 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` |+Inventory: 313 record-owning declarations, 1532 fields, 1489 strict fields, and 1396 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:86` | `AggregateSymbols` | data | no | `symbolNominals` | `nominals` | `!(Map Name ResolvedNominalType)` | `(.nominals)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:87` | `AggregateSymbols` | data | no | `symbolVertices` | `vertices` | `!(Map Name [Name])` | `(.vertices)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:88` | `AggregateSymbols` | data | no | `symbolMapped` | `mapped` | `!(Map MappedKey ResolvedMappedDecl)` | `(.mapped)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:125` | `AggregateTypeError` | data | yes | `aggregateTypeErrorLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:126` | `AggregateTypeError` | data | yes | `aggregateTypeErrorUseSite` | `useSite` | `!AggregateUseSite` | `(.useSite)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:127` | `AggregateTypeError` | data | yes | `aggregateTypeErrorReason` | `reason` | `!AggregateTypeErrorReason` | `(.reason)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:257` | `AggregateHaskellSource` | data | no | `aggregateSourceBuiltin` | `builtin` | `!(Maybe Text)` | `(.builtin)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:258` | `AggregateHaskellSource` | data | no | `aggregateSourceReference` | `reference` | `!(Maybe HaskellReference)` | `(.reference)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:259` | `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:45` | `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:46` | `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:47` | `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:48` | `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:49` | `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:50` | `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:55` | `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:56` | `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:57` | `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:62` | `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:63` | `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:64` | `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:69` | `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:70` | `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:71` | `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:72` | `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:73` | `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:74` | `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:75` | `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:80` | `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:81` | `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:82` | `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:87` | `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:88` | `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:89` | `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:94` | `CheckReportProcessReaction` | data | yes | `process` | `process` | `!Text` | `(.process)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:95` | `CheckReportProcessReaction` | data | yes | `verification` | `verification` | `!Text` | `(.verification)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:96` | `CheckReportProcessReaction` | data | yes | `version` | `version` | `!Natural` | `(.version)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:97` | `CheckReportProcessReaction` | data | yes | `fingerprint` | `fingerprint` | `!Text` | `(.fingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:98` | `CheckReportProcessReaction` | data | yes | `holeObligations` | `holeObligations` | `![Text]` | `(.holeObligations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:106` | `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:107` | `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:111` | `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:112` | `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:113` | `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:114` | `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:115` | `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:116` | `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/CheckReport.hs:117` | `CheckReport` | data | no | `processReactions` | `processReactions` | `![CheckReportProcessReaction]` | `(.processReactions)`, 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:48` | `ConsumerTypePlan` | data | yes | `nominalDependencies` | `nominalDependencies` | `!(Set Text)` | `(.nominalDependencies)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:153` | `RenderedType` | data | no | `rendered` | `rendered` | `!Text` | `(.rendered)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:154` | `RenderedType` | data | no | `precedence` | `precedence` | `!TypePrecedence` | `(.precedence)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:155` | `RenderedType` | data | no | `requirements` | `requirements` | `!(Set ImportRequirement)` | `(.requirements)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:156` | `RenderedType` | data | no | `mappedDependencies` | `mappedDependencies` | `!(Set MappedKey)` | `(.mappedDependencies)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:157` | `RenderedType` | data | no | `nominalDependencies` | `nominalDependencies` | `!(Set Text)` | `(.nominalDependencies)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:67` | `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:68` | `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:69` | `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:70` | `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:71` | `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:76` | `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:77` | `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:78` | `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:79` | `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:80` | `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:81` | `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:82` | `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:83` | `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:84` | `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:85` | `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:86` | `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:87` | `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:92` | `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:93` | `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:94` | `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:102` | `ProcessReactionSnapshot` | data | yes | `process` | `process` | `!Name` | `(.process)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:103` | `ProcessReactionSnapshot` | data | yes | `verification` | `verification` | `!Text` | `(.verification)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:104` | `ProcessReactionSnapshot` | data | yes | `version` | `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:105` | `ProcessReactionSnapshot` | data | yes | `fingerprint` | `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:110` | `ProcessReactionDrift` | data | yes | `process` | `process` | `!Name` | `(.process)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:111` | `ProcessReactionDrift` | data | yes | `previousReaction` | `previousReaction` | `!(Maybe ProcessReactionSnapshot)` | `(.previousReaction)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:112` | `ProcessReactionDrift` | data | yes | `currentReaction` | `currentReaction` | `!(Maybe ProcessReactionSnapshot)` | `(.currentReaction)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:302` | `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:303` | `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:67` | `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:68` | `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:69` | `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:70` | `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:71` | `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:72` | `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:73` | `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:74` | `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:75` | `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:80` | `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:81` | `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:82` | `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:83` | `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:84` | `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:89` | `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:90` | `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:91` | `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:92` | `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:93` | `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:98` | `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:99` | `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:100` | `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:105` | `NominalBoundary` | data | yes | `root` | `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:106` | `NominalBoundary` | data | yes | `path` | `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:107` | `NominalBoundary` | data | yes | `position` | `position` | `!Text` | `(.position)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:108` | `NominalBoundary` | data | yes | `nominal` | `nominal` | `!Text` | `(.nominal)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:109` | `NominalBoundary` | data | yes | `kind` | `kind` | `!Text` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:110` | `NominalBoundary` | data | yes | `prefix` | `prefix` | `!(Maybe Text)` | `(.prefix)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:111` | `NominalBoundary` | data | yes | `domainVersion` | `domainVersion` | `!(Maybe Text)` | `(.domainVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:112` | `NominalBoundary` | data | yes | `canonicalType` | `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:113` | `NominalBoundary` | data | yes | `ownership` | `ownership` | `!Text` | `(.ownership)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:118` | `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:119` | `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:120` | `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:121` | `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:122` | `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:123` | `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:124` | `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:125` | `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:126` | `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:131` | `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:132` | `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:133` | `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:138` | `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:139` | `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:140` | `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:141` | `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:146` | `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:147` | `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:148` | `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:149` | `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:150` | `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:151` | `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:152` | `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:157` | `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:158` | `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:159` | `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:160` | `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:165` | `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:166` | `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:167` | `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:172` | `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:173` | `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:174` | `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:175` | `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:176` | `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:177` | `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:178` | `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:179` | `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:180` | `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:181` | `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:186` | `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:187` | `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:188` | `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:189` | `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:190` | `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:191` | `CoverageReport` | data | yes | `nominalBoundaries` | `nominalBoundaries` | `![NominalBoundary]` | `(.nominalBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:192` | `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:193` | `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:194` | `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:195` | `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:196` | `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:197` | `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:143` | `CompatibilityVector` | data | yes | `cvPrivateHistoryRead` | `privateHistoryRead` | `!SurfaceVerdict` | `(.privateHistoryRead)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:144` | `CompatibilityVector` | data | yes | `cvOldBinaryReadNewEvents` | `oldBinaryReadNewEvents` | `!SurfaceVerdict` | `(.oldBinaryReadNewEvents)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:145` | `CompatibilityVector` | data | yes | `cvSnapshotHydration` | `snapshotHydration` | `!SurfaceVerdict` | `(.snapshotHydration)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:146` | `CompatibilityVector` | data | yes | `cvPublicConsumer` | `publicConsumer` | `!SurfaceVerdict` | `(.publicConsumer)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:147` | `CompatibilityVector` | data | yes | `cvPersistedIdentity` | `persistedIdentity` | `!SurfaceVerdict` | `(.persistedIdentity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:148` | `CompatibilityVector` | data | yes | `cvConsumerBuild` | `consumerBuild` | `!SurfaceVerdict` | `(.consumerBuild)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:149` | `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:162` | `MappedPersistedImpact` | data | yes | `mappedPersistedSurface` | `surface` | `!MappedPersistedSurface` | `(.surface)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:163` | `MappedPersistedImpact` | data | yes | `mappedPersistedVerdict` | `verdict` | `!SurfaceVerdict` | `(.verdict)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:181` | `ChangeContext` | data | no | `changeContextRoot` | `root` | `!Name` | `(.root)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:182` | `ChangeContext` | data | no | `changeContextPaths` | `paths` | `![Text]` | `(.paths)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:183` | `ChangeContext` | data | no | `contextKind` | `contextKind` | `!ContextKind` | `(.contextKind)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:184` | `ChangeContext` | data | no | `contextOriginalLabel` | `contextOriginalLabel` | `!Label` | `(.contextOriginalLabel)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:195` | `ChangeKind` | data | yes | `ckNode` | `node` | `!Name` | `(.node)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:196` | `ChangeKind` | data | yes | `ckFacet` | `facet` | `!Text` | `(.facet)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:197` | `ChangeKind` | data | yes | `ckSubject` | `subject` | `!Text` | `(.subject)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:198` | `ChangeKind` | data | yes | `ckCode` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:199` | `ChangeKind` | data | yes | `ckContext` | `context` | `!ChangeContext` | `(.context)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:200` | `ChangeKind` | data | yes | `ckVector` | `vector` | `!CompatibilityVector` | `(.vector)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:201` | `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:202` | `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:203` | `ChangeKind` | data | yes | `ckPaths` | `paths` | `![Text]` | `(.paths)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:204` | `ChangeKind` | data | yes | `ckDetail` | `detail` | `!Text` | `(.detail)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:708` | `DiffEnv` | data | yes | `deOld` | `old` | `!Spec` | `(.old)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:709` | `DiffEnv` | data | yes | `deNew` | `new` | `!Spec` | `(.new)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:710` | `DiffEnv` | data | yes | `oldService` | `oldService` | `!CheckedService` | `(.oldService)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:711` | `DiffEnv` | data | yes | `newService` | `newService` | `!CheckedService` | `(.newService)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:712` | `DiffEnv` | data | yes | `newValidationErrors` | `newValidationErrors` | `![Diagnostic]` | `(.newValidationErrors)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:764` | `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:765` | `Paired` | data | yes | `prAdded` | `added` | `![n]` | `(.added)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:766` | `Paired` | data | yes | `prRemoved` | `removed` | `![n]` | `(.removed)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:1803` | `GuardProposal` | data | no | `proposalBody` | `body` | `!ReplayBodyDelta` | `(.body)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:1804` | `GuardProposal` | data | no | `proposalTwin` | `twin` | `!Transition` | `(.twin)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:2193` | `EventFieldSig` | data | no | `eventFieldDslName` | `dslName` | `!Name` | `(.dslName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:2194` | `EventFieldSig` | data | no | `eventFieldSelector` | `selector` | `!Name` | `(.selector)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:2195` | `EventFieldSig` | data | no | `eventFieldWireKey` | `wireKey` | `!Text` | `(.wireKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:2196` | `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:46` | `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:47` | `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:48` | `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:49` | `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:50` | `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:51` | `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:52` | `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:53` | `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:54` | `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:55` | `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:56` | `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:57` | `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:62` | `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:63` | `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:64` | `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:65` | `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:66` | `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:67` | `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:91` | `ResolvedScalarProjection` | data | yes | `terminalNominal` | `terminalNominal` | `!(Maybe NominalLeaf)` | `(.terminalNominal)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:126` | `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:127` | `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:128` | `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:150` | `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:151` | `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:152` | `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:203` | `Loc` | newtype | yes | `unLoc` | `unLoc` | `Int` | explicit `unLoc` positional function | rendered/canonical output | `deriving stock (Show)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:219` | `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:220` | `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:221` | `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:222` | `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:229` | `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:230` | `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:231` | `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:232` | `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:240` | `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:241` | `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:242` | `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:243` | `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:244` | `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:285` | `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:286` | `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:287` | `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:288` | `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:289` | `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:290` | `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:298` | `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:299` | `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:300` | `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:305` | `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:306` | `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:307` | `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:312` | `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:313` | `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:314` | `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:315` | `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:326` | `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:327` | `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:328` | `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:337` | `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:338` | `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:339` | `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:340` | `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:341` | `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:342` | `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:343` | `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:352` | `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:353` | `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:354` | `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:355` | `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:361` | `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:362` | `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:363` | `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:364` | `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:365` | `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:366` | `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:367` | `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:368` | `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:369` | `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:372` | `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:373` | `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:374` | `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:375` | `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:376` | `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:377` | `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:378` | `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:386` | `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:387` | `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:497` | `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:498` | `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:499` | `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:500` | `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:508` | `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:509` | `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:510` | `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:521` | `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:522` | `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:523` | `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:524` | `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:525` | `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:532` | `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:533` | `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:539` | `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:540` | `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:541` | `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:551` | `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:552` | `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:554` | `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:557` | `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:562` | `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:566` | `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:567` | `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:585` | `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:586` | `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:587` | `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:607` | `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:608` | `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:609` | `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:610` | `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:611` | `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:612` | `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:613` | `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:616` | `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:617` | `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:618` | `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:619` | `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:647` | `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:648` | `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:649` | `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:656` | `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:657` | `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:658` | `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:659` | `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:660` | `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:673` | `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:674` | `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:675` | `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:676` | `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:683` | `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:684` | `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:685` | `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:686` | `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:687` | `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:688` | `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:689` | `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:692` | `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:693` | `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:694` | `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:695` | `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:696` | `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:706` | `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:707` | `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:714` | `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:715` | `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:716` | `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:717` | `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:724` | `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:725` | `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:733` | `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:734` | `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:745` | `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:746` | `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:747` | `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:753` | `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:754` | `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:760` | `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:761` | `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:762` | `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:763` | `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:764` | `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:765` | `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:772` | `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:773` | `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:774` | `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:775` | `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:781` | `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:782` | `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:783` | `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:794` | `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:795` | `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:805` | `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:806` | `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:807` | `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:808` | `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:809` | `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:815` | `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:816` | `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:817` | `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:818` | `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:819` | `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:820` | `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:826` | `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:827` | `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:828` | `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:829` | `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:830` | `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:831` | `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:832` | `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:833` | `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:834` | `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:847` | `ReactionBody` | data | yes | `version` | `version` | `!Natural` | `(.version)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:848` | `ReactionBody` | data | yes | `versionLoc` | `versionLoc` | `!Loc` | `(.versionLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:849` | `ReactionBody` | data | yes | `inputs` | `inputs` | `!(NonEmpty InputDecl)` | `(.inputs)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:850` | `ReactionBody` | data | yes | `reactions` | `reactions` | `!(NonEmpty ReactionNode)` | `(.reactions)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:851` | `ReactionBody` | data | yes | `timerPolicy` | `timerPolicy` | `!(Maybe TimerPolicy)` | `(.timerPolicy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:852` | `ReactionBody` | data | yes | `timers` | `timers` | `![ReactionTimerNode]` | `(.timers)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:857` | `ReactionNode` | data | yes | `on` | `on` | `!Name` | `(.on)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:858` | `ReactionNode` | data | yes | `arms` | `arms` | `!(NonEmpty ReactionArm)` | `(.arms)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:859` | `ReactionNode` | data | yes | `loc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:864` | `ReactionArm` | data | yes | `guard` | `guard` | `!ArmGuard` | `(.guard)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:865` | `ReactionArm` | data | yes | `body` | `body` | `!ArmBody` | `(.body)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:866` | `ReactionArm` | data | yes | `loc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:879` | `ArmBody` | data | yes | `advance` | `advance` | `!(Maybe AdvanceReaction)` | `(.advance)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:880` | `ArmBody` | data | yes | `followUps` | `followUps` | `![FollowUp]` | `(.followUps)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:885` | `AdvanceReaction` | data | yes | `command` | `command` | `!Name` | `(.command)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:886` | `AdvanceReaction` | data | yes | `fields` | `fields` | `![FieldBinding]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:887` | `AdvanceReaction` | data | yes | `accepted` | `accepted` | `!(Maybe [FollowUp])` | `(.accepted)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:888` | `AdvanceReaction` | data | yes | `silentNoAction` | `silentNoAction` | `!Bool` | `(.silentNoAction)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:889` | `AdvanceReaction` | data | yes | `loc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:900` | `ScheduleNode` | data | yes | `timer` | `timer` | `!Name` | `(.timer)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:901` | `ScheduleNode` | data | yes | `mode` | `mode` | `!ScheduleMode` | `(.mode)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:902` | `ScheduleNode` | data | yes | `fireAt` | `fireAt` | `!FireAtExpr` | `(.fireAt)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:903` | `ScheduleNode` | data | yes | `bindings` | `bindings` | `![FieldBinding]` | `(.bindings)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:904` | `ScheduleNode` | data | yes | `loc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:912` | `TimerPolicy` | data | yes | `maxAttempts` | `maxAttempts` | `!Int` | `(.maxAttempts)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:913` | `TimerPolicy` | data | yes | `deadLetter` | `deadLetter` | `!Text` | `(.deadLetter)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:914` | `TimerPolicy` | data | yes | `loc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:919` | `ReactionTimerNode` | data | yes | `name` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:920` | `ReactionTimerNode` | data | yes | `id` | `id` | `!IdExpr` | `(.id)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:921` | `ReactionTimerNode` | data | yes | `payload` | `payload` | `![PayloadField]` | `(.payload)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:922` | `ReactionTimerNode` | data | yes | `fire` | `fire` | `!FireNode` | `(.fire)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:923` | `ReactionTimerNode` | data | yes | `decodeUnknown` | `decodeUnknown` | `!Name` | `(.decodeUnknown)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:924` | `ReactionTimerNode` | data | yes | `loc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:941` | `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:943` | `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:944` | `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:945` | `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:946` | `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:947` | `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:948` | `ProcessNode` | data | yes | `body` | `body` | `!ProcessBody` | `(.body)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:949` | `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:950` | `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:951` | `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:968` | `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:969` | `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:970` | `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:971` | `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:972` | `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:973` | `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:974` | `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:975` | `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:976` | `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:977` | `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:978` | `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:979` | `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:980` | `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:981` | `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:982` | `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:983` | `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:984` | `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:985` | `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:986` | `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:987` | `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:988` | `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:989` | `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:990` | `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:991` | `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:1002` | `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:1003` | `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:1004` | `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:1009` | `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:1010` | `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:1011` | `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:1012` | `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:1020` | `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:1021` | `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:1022` | `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:1023` | `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:1024` | `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:1025` | `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:1026` | `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:1027` | `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:1028` | `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:1029` | `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:1030` | `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:1041` | `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:1042` | `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:1043` | `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:1044` | `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:1045` | `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:1051` | `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:1052` | `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:1053` | `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:1061` | `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:1062` | `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:1063` | `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:1065` | `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:1066` | `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:1067` | `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:1083` | `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:1084` | `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:1085` | `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:1086` | `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:1102` | `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:1103` | `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:1104` | `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:1111` | `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:1112` | `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:1113` | `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:1129` | `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:1130` | `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:1131` | `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:1132` | `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:1133` | `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:1134` | `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:1135` | `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:1136` | `IntakeNode` | data | yes | `idempotence` | `idempotence` | `!IdempotenceMode` | `(.idempotence)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1137` | `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:1138` | `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:1139` | `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:1140` | `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:1147` | `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:1152` | `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:1153` | `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:1154` | `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:1161` | `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:1162` | `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:1163` | `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:1164` | `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:1165` | `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:1166` | `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:1167` | `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:1169` | `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:1170` | `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:1171` | `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:1172` | `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:1178` | `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:1179` | `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:1180` | `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:1181` | `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:1187` | `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:1188` | `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:1189` | `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:1190` | `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:1191` | `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:1193` | `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:1194` | `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:1224` | `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:1225` | `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:1226` | `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:1227` | `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:1234` | `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:1235` | `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:1236` | `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:1246` | `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:1247` | `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:1248` | `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:1263` | `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:1264` | `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:1265` | `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:1266` | `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:1267` | `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:1268` | `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:1269` | `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:1270` | `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:1271` | `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:1272` | `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:1273` | `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:1274` | `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:1275` | `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:1276` | `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:1277` | `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:1284` | `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:1285` | `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:1286` | `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:1287` | `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:1288` | `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:1289` | `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:1290` | `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:1291` | `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:1292` | `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:1293` | `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:1294` | `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:1302` | `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:1303` | `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:1304` | `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:1333` | `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:1334` | `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:1335` | `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:1336` | `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:1344` | `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:1345` | `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:1346` | `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:1347` | `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:1354` | `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:1355` | `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:1356` | `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:1357` | `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:1358` | `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:1359` | `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:1360` | `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:1361` | `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:1362` | `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:1363` | `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:1364` | `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:1365` | `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:1366` | `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:1397` | `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:1398` | `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:1399` | `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:1400` | `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:1401` | `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:1402` | `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:1408` | `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:1409` | `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:1410` | `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:1411` | `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:1422` | `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:1423` | `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:1424` | `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:1431` | `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:1432` | `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:1433` | `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:1434` | `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:1435` | `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:1436` | `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:1437` | `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:1438` | `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:1443` | `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:1444` | `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:1445` | `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:1446` | `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:1454` | `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:1455` | `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:1456` | `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:1457` | `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:1458` | `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:1459` | `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:1460` | `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:1461` | `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:1496` | `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:1497` | `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:1498` | `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:1499` | `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:1500` | `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:1501` | `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:1502` | `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:1503` | `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:1504` | `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:1505` | `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:1506` | `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:1532` | `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:1534` | `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:1535` | `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:1536` | `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:1537` | `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:1539` | `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:1540` | `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:1541` | `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:1542` | `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:1562` | `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:1563` | `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:1564` | `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:1610` | `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:1611` | `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:1612` | `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:1613` | `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:1614` | `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:1615` | `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:1616` | `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:1617` | `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:1618` | `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:152` | `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:153` | `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:213` | `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:214` | `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:217` | `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:218` | `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:219` | `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:220` | `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:221` | `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:457` | `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:458` | `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:459` | `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:460` | `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:461` | `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:462` | `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:529` | `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:530` | `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:42` | `MappedCodecPlan` | data | yes | `consumerType` | `consumerType` | `!ConsumerTypePlan` | `(.consumerType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedCodecPlan.hs:43` | `MappedCodecPlan` | data | yes | `resolvedExpression` | `resolvedExpression` | `!ResolvedTypeExpr` | `(.resolvedExpression)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedCodecPlan.hs:44` | `MappedCodecPlan` | data | yes | `authority` | `authority` | `!(Set MappedAuthorityMode)` | `(.authority)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `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:70` | `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:71` | `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:72` | `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:82` | `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:83` | `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:84` | `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:85` | `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/ProcessReaction.hs:42` | `CheckedFollowUp` | newtype | yes | `syntax` | `syntax` | `FollowUp` | `(.syntax)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:46` | `CheckedReactionArm` | data | yes | `input` | `input` | `!Name` | `(.input)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:47` | `CheckedReactionArm` | data | yes | `ordinal` | `ordinal` | `!Int` | `(.ordinal)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:48` | `CheckedReactionArm` | data | yes | `guard` | `guard` | `!CheckedReactionGuard` | `(.guard)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:49` | `CheckedReactionArm` | data | yes | `body` | `body` | `!ArmBody` | `(.body)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:53` | `CheckedReactionTimer` | newtype | yes | `syntax` | `syntax` | `ReactionTimerNode` | `(.syntax)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:57` | `CheckedProcessReaction` | data | yes | `version` | `version` | `!Natural` | `(.version)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:58` | `CheckedProcessReaction` | data | yes | `inputs` | `inputs` | `!(NonEmpty InputDecl)` | `(.inputs)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:59` | `CheckedProcessReaction` | data | yes | `arms` | `arms` | `![CheckedReactionArm]` | `(.arms)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:60` | `CheckedProcessReaction` | data | yes | `timers` | `timers` | `![CheckedReactionTimer]` | `(.timers)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:61` | `CheckedProcessReaction` | data | yes | `fingerprint` | `fingerprint` | `!Text` | `(.fingerprint)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:62` | `CheckedProcessReaction` | data | yes | `verification` | `verification` | `!Text` | `(.verification)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:63` | `CheckedProcessReaction` | data | yes | `holeObligations` | `holeObligations` | `![Text]` | `(.holeObligations)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:90` | `ProcessReactionDiagnostic` | data | yes | `loc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:91` | `ProcessReactionDiagnostic` | data | yes | `code` | `code` | `!ProcessReactionDiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProcessReaction.hs:92` | `ProcessReactionDiagnostic` | data | yes | `message` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `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:55` | `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:56` | `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:71` | `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:72` | `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:73` | `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:74` | `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:75` | `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:216` | `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:217` | `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:218` | `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:54` | `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:55` | `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:56` | `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:61` | `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:62` | `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:67` | `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:68` | `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:69` | `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:87` | `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:88` | `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:89` | `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:94` | `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:95` | `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:96` | `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:137` | `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:138` | `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:139` | `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:140` | `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:141` | `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:142` | `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:143` | `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:144` | `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:145` | `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:146` | `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:147` | `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:148` | `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:149` | `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:150` | `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:151` | `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:152` | `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:153` | `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:154` | `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:155` | `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:156` | `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:193` | `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:194` | `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:195` | `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:154` | `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:155` | `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:156` | `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:157` | `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:165` | `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:166` | `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:167` | `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:198` | `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:200` | `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:202` | `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:210` | `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:211` | `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:219` | `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:220` | `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:221` | `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:222` | `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:334` | `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:335` | `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:336` | `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:337` | `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:338` | `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:489` | `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:490` | `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:491` | `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:492` | `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:493` | `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:494` | `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:495` | `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:496` | `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:497` | `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:498` | `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:499` | `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:500` | `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:501` | `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:502` | `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:503` | `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:504` | `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:506` | `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:507` | `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:508` | `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:509` | `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:510` | `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:511` | `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:512` | `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:513` | `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:514` | `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:515` | `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:517` | `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:519` | `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:523` | `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:524` | `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:532` | `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:533` | `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:534` | `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:535` | `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:542` | `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:544` | `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:546` | `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:548` | `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:2457` | `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:2458` | `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:2473` | `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:2474` | `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:2475` | `StructuralProjection` | data | yes | `getter` | `getter` | `!Text` | `(.getter)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2476` | `StructuralProjection` | data | yes | `rawGetter` | `rawGetter` | `!(Maybe Text)` | `(.rawGetter)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2477` | `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:2478` | `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:2479` | `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:2480` | `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:2481` | `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:2482` | `StructuralProjection` | data | yes | `fixtures` | `fixtures` | `!QualifiedValueName` | `(.fixtures)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2483` | `StructuralProjection` | data | yes | `terminalNominal` | `terminalNominal` | `!(Maybe NominalLeaf)` | `(.terminalNominal)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2484` | `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:4282` | `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:4283` | `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:4284` | `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:8221` | `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:8222` | `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:8223` | `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:8224` | `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:8232` | `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:8233` | `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:8234` | `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:8370` | `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:8371` | `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:8447` | `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:8448` | `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:46` | `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:47` | `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:48` | `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:49` | `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:50` | `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:51` | `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:52` | `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:53` | `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:54` | `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:55` | `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:56` | `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:57` | `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:58` | `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:59` | `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:60` | `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:61` | `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:62` | `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:63` | `ScaffoldRecord` | data | yes | `processReactions` | `processReactions` | `![ProcessReactionRecordRow]` | `(.processReactions)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:64` | `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:69` | `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:70` | `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:71` | `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/ScaffoldRecord.hs:79` | `ProcessReactionRecordRow` | data | yes | `processName` | `processName` | `!Text` | `(.processName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:80` | `ProcessReactionRecordRow` | data | yes | `verification` | `verification` | `!Text` | `(.verification)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:81` | `ProcessReactionRecordRow` | data | yes | `version` | `version` | `!(Maybe Natural)` | `(.version)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:82` | `ProcessReactionRecordRow` | data | yes | `fingerprint` | `fingerprint` | `!(Maybe Text)` | `(.fingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:83` | `ProcessReactionRecordRow` | data | yes | `holeObligations` | `holeObligations` | `![Text]` | `(.holeObligations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:197` | `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:198` | `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:199` | `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:200` | `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:201` | `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:214` | `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:215` | `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:216` | `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:217` | `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:222` | `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:223` | `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:224` | `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:225` | `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:226` | `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:247` | `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:248` | `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:249` | `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:250` | `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:260` | `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:261` | `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:262` | `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:267` | `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:268` | `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:269` | `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:274` | `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:275` | `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:280` | `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:281` | `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:282` | `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:283` | `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:284` | `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:285` | `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:286` | `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:287` | `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:288` | `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:289` | `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:290` | `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:291` | `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:292` | `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:293` | `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:294` | `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:295` | `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:296` | `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:297` | `ScaffoldReport` | data | yes | `processReactionCoordinationDrift` | `processReactionCoordinationDrift` | `![ProcessReactionDrift]` | `(.processReactionCoordinationDrift)`, 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 | `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:299` | `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:300` | `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:301` | `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:302` | `ScaffoldReport` | data | yes | `processReactionRows` | `processReactionRows` | `![ProcessReactionRecordRow]` | `(.processReactionRows)`, 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 | `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:304` | `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:305` | `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:306` | `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:307` | `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:308` | `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:313` | `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:314` | `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:315` | `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:67` | `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:68` | `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:73` | `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:79` | `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:80` | `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:92` | `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:93` | `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:94` | `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:95` | `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:82` | `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:83` | `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:84` | `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:85` | `ConformanceRendering` | data | no | `nominals` | `nominals` | `![NominalLeaf]` | `(.nominals)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/StructuralConformance.hs:86` | `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:87` | `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/TransitionFamily.hs:39` | `TransitionFamilyKey` | data | yes | `familyMode` | `mode` | `!TransitionMode` | `(.mode)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:40` | `TransitionFamilyKey` | data | yes | `familySource` | `source` | `!Name` | `(.source)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:41` | `TransitionFamilyKey` | data | yes | `familyCommand` | `command` | `!Name` | `(.command)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:53` | `TransitionFamilyDelta` | data | yes | `familyKey` | `familyKey` | `!TransitionFamilyKey` | `(.familyKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:54` | `TransitionFamilyDelta` | data | yes | `oldRemainder` | `oldRemainder` | `![Transition]` | `(.oldRemainder)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:55` | `TransitionFamilyDelta` | data | yes | `newRemainder` | `newRemainder` | `![Transition]` | `(.newRemainder)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:61` | `ReplayBodyKey` | newtype | yes | `unReplayBodyKey` | `unReplayBodyKey` | `Text` | explicit `unReplayBodyKey` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:76` | `ReplayBodyDelta` | data | yes | `bodyFamilyKey` | `bodyFamilyKey` | `!TransitionFamilyKey` | `(.bodyFamilyKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:77` | `ReplayBodyDelta` | data | yes | `bodyKey` | `bodyKey` | `!ReplayBodyKey` | `(.bodyKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:78` | `ReplayBodyDelta` | data | yes | `oldBodyMembers` | `oldBodyMembers` | `![Transition]` | `(.oldBodyMembers)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:79` | `ReplayBodyDelta` | data | yes | `newBodyMembers` | `newBodyMembers` | `![Transition]` | `(.newBodyMembers)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TransitionFamily.hs:80` | `ReplayBodyDelta` | data | yes | `bodyStatus` | `bodyStatus` | `!ReplayBodyStatus` | `(.bodyStatus)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:92` | `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:98` | `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:104` | `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:110` | `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:116` | `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:171` | `ConsumerNominalBinding` | data | yes | `haskell` | `haskell` | `!HaskellSource` | `(.haskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:172` | `ConsumerNominalBinding` | data | yes | `binding` | `binding` | `!QualifiedValueName` | `(.binding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:173` | `ConsumerNominalBinding` | data | yes | `bindingVersion` | `bindingVersion` | `!BindingVersion` | `(.bindingVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:174` | `ConsumerNominalBinding` | data | yes | `canonical` | `canonical` | `!CanonicalTypeId` | `(.canonical)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:175` | `ConsumerNominalBinding` | data | yes | `fixtures` | `fixtures` | `!QualifiedValueName` | `(.fixtures)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:176` | `ConsumerNominalBinding` | data | yes | `initial` | `initial` | `!(Maybe QualifiedValueName)` | `(.initial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:192` | `NominalLeaf` | data | yes | `name` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:193` | `NominalLeaf` | data | yes | `kind` | `kind` | `!NominalLeafKind` | `(.kind)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:194` | `NominalLeaf` | data | yes | `ownership` | `ownership` | `!NominalLeafOwnership` | `(.ownership)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:195` | `NominalLeaf` | data | yes | `loc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:209` | `NominalLeafError` | newtype | yes | `nominalLeafIssues` | `nominalLeafIssues` | `NonEmpty NominalLeafIssue` | `(.nominalLeafIssues)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:320` | `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:321` | `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:322` | `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:323` | `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:324` | `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:325` | `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:326` | `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:327` | `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:332` | `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:333` | `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:334` | `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:335` | `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:336` | `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:337` | `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:338` | `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:394` | `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:417` | `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:418` | `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:419` | `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:420` | `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:421` | `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:422` | `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:427` | `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:428` | `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:429` | `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:430` | `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:465` | `UseSite` | data | yes | `root` | `root` | `!RootRef` | `(.root)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:466` | `UseSite` | data | yes | `mappedKey` | `mappedKey` | `!MappedKey` | `(.mappedKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:471` | `NominalRootSite` | data | yes | `root` | `root` | `!RootRef` | `(.root)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:472` | `NominalRootSite` | data | yes | `nominal` | `nominal` | `!Name` | `(.nominal)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:473` | `NominalRootSite` | data | yes | `segments` | `segments` | `![PathSeg]` | `(.segments)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:489` | `UsePath` | data | yes | `upRoot` | `root` | `!RootRef` | `(.root)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:490` | `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:510` | `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:511` | `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:512` | `TypeGraph` | data | yes | `nominalLeaves` | `nominalLeaves` | `!(Map Name NominalLeaf)` | `(.nominalLeaves)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:513` | `TypeGraph` | data | yes | `unsupportedNominalLeafKinds` | `unsupportedNominalLeafKinds` | `!(Map Name Text)` | `(.unsupportedNominalLeafKinds)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:514` | `TypeGraph` | data | yes | `nominalReachability` | `nominalReachability` | `!(Map MappedKey (Set Name))` | `(.nominalReachability)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:515` | `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:516` | `TypeGraph` | data | yes | `nominalRootSites` | `nominalRootSites` | `![NominalRootSite]` | `(.nominalRootSites)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:517` | `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:518` | `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:519` | `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:520` | `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:521` | `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:1142` | `TypeExprAlgebra` | data | yes | `onText` | `onText` | `a` | `(.onText)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1143` | `TypeExprAlgebra` | data | yes | `onInt` | `onInt` | `a` | `(.onInt)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1144` | `TypeExprAlgebra` | data | yes | `onInteger` | `onInteger` | `a` | `(.onInteger)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1145` | `TypeExprAlgebra` | data | yes | `onBool` | `onBool` | `a` | `(.onBool)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1146` | `TypeExprAlgebra` | data | yes | `onNatural` | `onNatural` | `a` | `(.onNatural)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1147` | `TypeExprAlgebra` | data | yes | `onTime` | `onTime` | `a` | `(.onTime)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1148` | `TypeExprAlgebra` | data | yes | `onJson` | `onJson` | `a` | `(.onJson)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1149` | `TypeExprAlgebra` | data | yes | `onOptional` | `onOptional` | `a -> a` | `(.onOptional)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1150` | `TypeExprAlgebra` | data | yes | `onList` | `onList` | `a -> a` | `(.onList)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1151` | `TypeExprAlgebra` | data | yes | `onMap` | `onMap` | `a -> a` | `(.onMap)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1152` | `TypeExprAlgebra` | data | yes | `onKeyedMap` | `onKeyedMap` | `NominalLeaf -> a -> a` | `(.onKeyedMap)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1153` | `TypeExprAlgebra` | data | yes | `onRef` | `onRef` | `MappedKey -> a` | `(.onRef)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1154` | `TypeExprAlgebra` | data | yes | `onNominal` | `onNominal` | `NominalLeaf -> a` | `(.onNominal)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1174` | `MappedShapeAlgebra` | data | yes | `onRecord` | `onRecord` | `Name -> UnknownFields -> [ResolvedWireField] -> a` | `(.onRecord)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1175` | `MappedShapeAlgebra` | data | yes | `onEnum` | `onEnum` | `[WireEnum] -> a` | `(.onEnum)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1176` | `MappedShapeAlgebra` | data | yes | `onUnion` | `onUnion` | `UnionEncoding -> [ResolvedWireArm] -> a` | `(.onUnion)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1186` | `MappedDeclAlgebra` | data | yes | `onStructuralDecl` | `onStructuralDecl` | `StructuralDecl -> ResolvedMappedShape -> a` | `(.onStructuralDecl)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:1187` | `MappedDeclAlgebra` | data | yes | `onOpaqueDecl` | `onOpaqueDecl` | `OpaqueDecl -> a` | `(.onOpaqueDecl)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:769` | `Diagnostic` | data | yes | `line` | `line` | `!Int` | `(.line)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:770` | `Diagnostic` | data | yes | `severity` | `severity` | `!Severity` | `(.severity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:771` | `Diagnostic` | data | yes | `code` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:772` | `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:773` | `Diagnostic` | data | yes | `message` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:1664` | `NullabilityFacts` | data | no | `nfTopNull` | `topNull` | `!Bool` | `(.topNull)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:1665` | `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:545` | `WorkspaceLocation` | data | yes | `wlFile` | `file` | `!WorkspaceFile` | `(.file)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:546` | `WorkspaceLocation` | data | yes | `wlLine` | `line` | `!Int` | `(.line)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:547` | `WorkspaceLocation` | data | yes | `wlRole` | `role` | `!Text` | `(.role)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:557` | `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:558` | `WorkspaceDiagnostic` | data | yes | `wdSeverity` | `severity` | `!Severity` | `(.severity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:559` | `WorkspaceDiagnostic` | data | yes | `wdCode` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:560` | `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:561` | `WorkspaceDiagnostic` | data | yes | `wdMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:628` | `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:637` | `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:638` | `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:653` | `WorkspaceMember` | data | yes | `wmPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:655` | `WorkspaceMember` | data | yes | `wmSpec` | `spec` | `!Spec` | `(.spec)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:657` | `WorkspaceMember` | data | yes | `wmSourceLanguage` | `sourceLanguage` | `!SourceLanguage` | `(.sourceLanguage)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:660` | `WorkspaceMember` | data | yes | `wmSourceIndex` | `sourceIndex` | `!SemanticSourceIndex` | `(.sourceIndex)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:662` | `WorkspaceMember` | data | yes | `wmLineBase` | `lineBase` | `!Int` | `(.lineBase)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:664` | `WorkspaceMember` | data | yes | `wmLineCount` | `lineCount` | `!Int` | `(.lineCount)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:680` | `WorkspaceSpec` | data | yes | `wsService` | `service` | `!Text` | `(.service)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:681` | `WorkspaceSpec` | data | yes | `wsManifestPath` | `manifestPath` | `!FilePath` | `(.manifestPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:684` | `WorkspaceSpec` | data | yes | `wsLanguageContract` | `languageContract` | `!EffectiveLanguageContract` | `(.languageContract)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:686` | `WorkspaceSpec` | data | yes | `wsContext` | `context` | `!Name` | `(.context)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:687` | `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:688` | `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:689` | `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:691` | `WorkspaceSpec` | data | yes | `wsMembers` | `members` | `![WorkspaceMember]` | `(.members)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:692` | `WorkspaceSpec` | data | yes | `wsMergedSpec` | `mergedSpec` | `!Spec` | `(.mergedSpec)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:694` | `WorkspaceSpec` | data | yes | `wsSourceIndex` | `sourceIndex` | `!SemanticSourceIndex` | `(.sourceIndex)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:695` | `WorkspaceSpec` | data | yes | `wsLineMap` | `lineMap` | `!LineMap` | `(.lineMap)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:696` | `WorkspaceSpec` | data | yes | `wsOwnership` | `ownership` | `!OwnershipIndex` | `(.ownership)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:1309` | `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)` |
src/Keiro/Dsl/AggregateType.hs view
@@ -13,6 +13,7 @@     aggregateSymbols,     aggregateSymbolsFromGraph,     aggregateSymbolsFromGraphResult,+    lookupAggregateNominal,     AggregateTypeErrorReason (..),     AggregateTypeError (..),     resolveAggregateType,@@ -110,6 +111,9 @@       mapped = mappedDeclarations     } +lookupAggregateNominal :: Name -> AggregateSymbols -> Maybe ResolvedNominalType+lookupAggregateNominal name symbols = Map.lookup name ((.nominals) symbols)+ data AggregateTypeErrorReason   = UnknownAggregateType !Name   | UnsupportedAggregateShape !TypeExpr@@ -137,6 +141,7 @@     TOptional {} -> unsupportedShape     TList {} -> unsupportedShape     TMap {} -> unsupportedShape+    TKeyedMap {} -> unsupportedShape     TRef name       | Just nominal <- Map.lookup name ((.nominals) symbols) -> pure (AggregateNominal nominal)       | Map.member name ((.vertices) symbols) -> pure (AggregateVertex name)@@ -245,6 +250,7 @@   TOptional value -> "Optional(" <> typeExprCanonicalName value <> ")"   TList value -> "List(" <> typeExprCanonicalName value <> ")"   TMap value -> "Map(" <> typeExprCanonicalName value <> ")"+  TKeyedMap key value -> "Map[" <> key <> "](" <> typeExprCanonicalName value <> ")"   TRef name -> name  data AggregateHaskellSource = AggregateHaskellSource
src/Keiro/Dsl/CanonicalEncoding.hs view
@@ -8,6 +8,7 @@ module Keiro.Dsl.CanonicalEncoding   ( canonicalExpr,     canonicalTransition,+    canonicalReactionSurface,     canonicalDomainOutcomeTypes,     canonicalTransitionOutcome,     foldFingerprint128,@@ -15,8 +16,11 @@ where  import Data.Bits (shiftR, xor, (.&.), (.|.))+import Data.ByteString qualified as BS+import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Data.Text qualified as T+import Data.Text.Encoding qualified as Text import Keiro.Dsl.Grammar import Numeric (showHex) import Prettyprinter@@ -35,6 +39,131 @@   renderStrict     . layoutPretty LayoutOptions {layoutPageWidth = Unbounded}     . docTransition++-- | Frozen semantic encoding for the Language 6 reaction fingerprint. Every+-- component is UTF-8 length framed, so punctuation and non-ASCII text cannot+-- alias adjacent fields. Operator-only timer retry policy is deliberately+-- absent: it has its own diff diagnostic and is not reaction replay identity.+canonicalReactionSurface :: ReactionBody -> Text+canonicalReactionSurface reaction =+  record+    "reaction-v1"+    [ scalar (T.pack (show reaction.version)),+      list (map input (NE.toList reaction.inputs)),+      list (map reactionNode (NE.toList reaction.reactions)),+      scalar "target-keyed-source-event-occurrence-v1",+      list (map timer reaction.timers)+    ]+  where+    input value =+      record+        "input"+        [ scalar value.name,+          list [record "field" [scalar field.name, optional scalar field.valueType] | field <- value.fields],+          optional typeExpr value.valueType+        ]+    typeExpr = \case+      TText -> scalar "text"+      TInt -> scalar "int"+      TInteger -> scalar "integer"+      TBool -> scalar "bool"+      TNatural -> scalar "natural"+      TTime -> scalar "time"+      TJson -> scalar "json"+      TOptional value -> record "optional" [typeExpr value]+      TList value -> record "list-type" [typeExpr value]+      TMap value -> record "map-type" [typeExpr value]+      TKeyedMap key value -> record "keyed-map-type" [scalar key, typeExpr value]+      TRef name -> record "ref" [scalar name]+    reactionNode node = record "on" [scalar node.on, list (map arm (NE.toList node.arms))]+    arm value = record "arm" [armGuard value.guard, armBody value.body]+    armGuard = \case+      UnconditionalArm -> scalar "unconditional"+      WhenArm expression -> record "when" [scalar (canonicalExpr expression)]+      OtherwiseArm -> scalar "otherwise"+    armBody = \case+      NoAction -> scalar "no-action"+      ArmActions advance followUps -> record "actions" [optional advanceNode advance, list (map followUp followUps)]+    advanceNode value =+      record+        "advance"+        [ scalar value.command,+          list (map binding value.fields),+          optional (list . map followUp) value.accepted,+          bool value.silentNoAction+        ]+    followUp = \case+      FollowDispatch value -> dispatch value+      FollowSchedule value -> schedule value+      FollowCancel name _ -> record "cancel" [scalar name]+    dispatch value =+      record+        "dispatch"+        [ scalar value.target,+          scalar value.key,+          scalar value.command,+          list (map binding value.fields),+          disposition value.disposition+        ]+    disposition value =+      record+        "dispatch-disposition"+        [disp value.onAppended, disp value.onDuplicate, disp value.onFailed]+    disp = \case+      DAckOk -> scalar "ack-ok"+      DRetry -> scalar "retry"+      DDeadLetter value -> record "dead-letter" [scalar value]+    schedule value =+      record+        "schedule"+        [ scalar value.timer,+          scalar (case value.mode of ScheduleRearm -> "rearm"; ScheduleOnce -> "once"),+          fireAt value.fireAt,+          list (map binding value.bindings)+        ]+    fireAt value = record "fire-at" [scalar value.field, scalar value.window]+    binding value = record "binding" [scalar value.name, optional scalar value.value]+    timer value =+      record+        "timer"+        [ scalar value.name,+          identity value.id,+          list (map payload value.payload),+          fire value.fire,+          scalar value.decodeUnknown+        ]+    identity value = record "uuidv5" [scalar value.prefix, scalar value.field]+    payload = \case+      PayloadConstant name value -> record "payload-constant" [scalar name, scalar value]+      PayloadTyped name valueType -> record "payload-typed" [scalar name, optional scalar valueType]+    fire value =+      record+        "fire"+        [ scalar value.target,+          scalar value.key,+          scalar value.command,+          list (map binding value.fields),+          identity value.firedEventId,+          fireDisposition value.disposition+        ]+    fireDisposition value =+      record+        "fire-disposition"+        [ outcome value.onOk,+          outcome value.onReject,+          outcome value.onAmbiguous,+          outcome value.onError,+          outcome value.notMine+        ]+    outcome OFired = scalar "fired"+    outcome ORetry = scalar "retry"++    record tag values = scalar tag <> list values+    list values = scalar (T.concat values)+    optional render = maybe (scalar "none") (record "some" . pure . render)+    bool False = scalar "false"+    bool True = scalar "true"+    scalar value = T.pack (show (BS.length (Text.encodeUtf8 value))) <> ":" <> value  -- | Deterministic command-behavior identity for the aggregate-wide outcome -- types. This is deliberately separate from 'canonicalTransition', whose bytes
src/Keiro/Dsl/CheckReport.hs view
@@ -19,6 +19,7 @@     CheckReportEntry (..),     CheckReportSummary (..),     CheckReportMember (..),+    CheckReportProcessReaction (..),     CheckReport,     effectiveDenyCodes,     checkReport,@@ -32,10 +33,13 @@ import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text)+import Keiro.Dsl.Grammar (Node (..), ProcessBody (..), ProcessNode (..), Spec (..)) import Keiro.Dsl.LanguageVersion (LanguageSupport (..), LanguageVersion, SourceLanguage, declaredLanguageVersionMaybe, languageSupportText, sourceFormText)-import Keiro.Dsl.SemanticContract (EffectiveLanguageContract (..), effectiveLanguageSupport, effectiveRuntimeSemantics)+import Keiro.Dsl.ProcessReaction (CheckedProcessReaction (..), checkProcessReaction)+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedSpec, checkedTypeGraph, effectiveLanguageSupport, effectiveRuntimeSemantics) import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode, Severity (..), diagnosticCodeText) import Keiro.Dsl.Workspace (WorkspaceDiagnostic (..), WorkspaceLocation (..), WorkspaceMember (..), WorkspaceSpec (..), workspaceDisplayPath)+import Numeric.Natural (Natural)  data CheckReportLanguage = CheckReportLanguage   { sourceForm :: !Text,@@ -86,6 +90,15 @@   }   deriving stock (Eq, Show) +data CheckReportProcessReaction = CheckReportProcessReaction+  { process :: !Text,+    verification :: !Text,+    version :: !Natural,+    fingerprint :: !Text,+    holeObligations :: ![Text]+  }+  deriving stock (Eq, Show)+ data CheckReportKind = SourceReport | WorkspaceReport   deriving stock (Eq, Show) @@ -100,7 +113,8 @@     diagnostics :: ![CheckReportEntry],     summary :: !CheckReportSummary,     ok :: !Bool,-    members :: ![CheckReportMember]+    members :: ![CheckReportMember],+    processReactions :: ![CheckReportProcessReaction]   }   deriving stock (Eq, Show) @@ -114,12 +128,12 @@ checkReport ::   FilePath ->   SourceLanguage ->-  EffectiveLanguageContract ->+  CheckedService ->   CheckReportEnforcement ->   [Diagnostic] ->   Set DiagnosticCode ->   CheckReport-checkReport subject sourceLanguage contract enforcement diagnostics deniedCodes =+checkReport subject sourceLanguage service enforcement diagnostics deniedCodes =   buildReport     SourceReport     subject@@ -127,16 +141,19 @@     enforcement     (map (sourceEntry subject deniedCodes) diagnostics)     []+    (reactionRows service)+  where+    contract = checkedLanguageContract service  workspaceCheckReport ::   FilePath ->   WorkspaceSpec ->-  EffectiveLanguageContract ->+  CheckedService ->   CheckReportEnforcement ->   [WorkspaceDiagnostic] ->   Set DiagnosticCode ->   CheckReport-workspaceCheckReport subject workspace contract enforcement diagnostics deniedCodes =+workspaceCheckReport subject workspace service enforcement diagnostics deniedCodes =   buildReport     WorkspaceReport     subject@@ -144,6 +161,9 @@     enforcement     (map (workspaceEntry subject deniedCodes) diagnostics)     (map memberValue ((.members) workspace))+    (reactionRows service)+  where+    contract = checkedLanguageContract service  -- | The report for a workspace refused during composition, before any service -- graph exists. Composition refusals are coded diagnostics, so they belong in@@ -164,6 +184,7 @@     enforcement     (map (workspaceEntry subject deniedCodes) (NE.toList diagnostics))     []+    []  buildReport ::   CheckReportKind ->@@ -172,8 +193,9 @@   CheckReportEnforcement ->   [CheckReportEntry] ->   [CheckReportMember] ->+  [CheckReportProcessReaction] ->   CheckReport-buildReport kind subject language enforcement entries members =+buildReport kind subject language enforcement entries members processReactions =   CheckReport     { kind = kind,       subject = subject,@@ -182,7 +204,8 @@       diagnostics = entries,       summary = summary,       ok = (.errors) summary == 0 && (.deniedWarnings) summary == 0,-      members = members+      members = members,+      processReactions = processReactions     }   where     summary =@@ -192,6 +215,23 @@           deniedWarnings = length [() | entry <- entries, (.denied) entry]         } +reactionRows :: CheckedService -> [CheckReportProcessReaction]+reactionRows service =+  [ CheckReportProcessReaction+      { process = (.id) process,+        verification = (.verification) checked,+        version = (.version) checked,+        fingerprint = (.fingerprint) checked,+        holeObligations = (.holeObligations) checked+      }+  | NProcess process <- (.nodes) spec,+    ReactionProcessBody {} <- [(.body) process],+    Right graph <- [checkedTypeGraph service],+    Right checked <- [checkProcessReaction (checkedLanguageContract service) graph spec process]+  ]+  where+    spec = checkedSpec service+ sourceLanguageValue :: SourceLanguage -> EffectiveLanguageContract -> CheckReportLanguage sourceLanguageValue sourceLanguage contract =   languageValue@@ -271,6 +311,7 @@           "language" .= fmap languageJson ((.language) report),           "enforcement" .= enforcementJson ((.enforcement) report),           "diagnostics" .= map entryJson ((.diagnostics) report),+          "processReactions" .= map processReactionJson ((.processReactions) report),           "summary" .= summaryJson ((.summary) report),           "ok" .= (.ok) report         ]@@ -334,6 +375,16 @@     [ "path" .= (.path) member,       "sourceForm" .= (.sourceForm) member,       "declaredLanguageVersion" .= (.declaredLanguageVersion) member+    ]++processReactionJson :: CheckReportProcessReaction -> Value+processReactionJson reaction =+  object+    [ "process" .= (.process) reaction,+      "verification" .= (.verification) reaction,+      "version" .= (.version) reaction,+      "fingerprint" .= (.fingerprint) reaction,+      "holeObligations" .= (.holeObligations) reaction     ]  severityText :: Severity -> Text
src/Keiro/Dsl/ConsumerTypePlan.hs view
@@ -44,7 +44,8 @@ data ConsumerTypePlan = ConsumerTypePlan   { haskellType :: !HaskellTypeOccurrence,     imports :: ![ImportRequirement],-    dependencies :: !(Set MappedKey)+    dependencies :: !(Set MappedKey),+    nominalDependencies :: !(Set Text)   }   deriving stock (Eq, Show) @@ -55,12 +56,13 @@  planConsumerType :: TypeGraph -> ResolvedTypeExpr -> Either ConsumerTypePlanError ConsumerTypePlan planConsumerType graph expression = do-  RenderedType {rendered, requirements, mappedDependencies} <- plan expression+  RenderedType {rendered, requirements, mappedDependencies, nominalDependencies} <- plan expression   pure     ConsumerTypePlan       { haskellType = HaskellTypeOccurrence rendered,         imports = Set.toAscList requirements,-        dependencies = mappedDependencies+        dependencies = mappedDependencies,+        nominalDependencies = nominalDependencies       }   where     plan = \case@@ -74,6 +76,7 @@       ROptional value -> application "Maybe" [ImportRequirement "base" "Data.Maybe" "Maybe"] <$> plan value       RList value -> listType <$> plan value       RMap value -> mapType <$> plan value+      RKeyedMap key value -> keyedMapType (nominalRenderedType key) <$> plan value       RRef key -> case Map.lookup key ((.declarations) graph) of         Nothing -> Left (ConsumerTypePlanUnknownDeclaration key)         Just declaration ->@@ -83,8 +86,10 @@                   { rendered = (.valueType) source,                     precedence = AtomicType,                     requirements = Set.singleton (ImportRequirement ((.package) source) ((.moduleName) source) ((.valueType) source)),-                    mappedDependencies = Set.insert key (Map.findWithDefault Set.empty key ((.reachability) graph))+                    mappedDependencies = Set.insert key (Map.findWithDefault Set.empty key ((.reachability) graph)),+                    nominalDependencies = Map.findWithDefault Set.empty key ((.nominalReachability) graph)                   }+      RNominal leaf -> Right (nominalRenderedType leaf)      atom rendered requiredImports =       Right@@ -92,7 +97,8 @@           { rendered,             precedence = AtomicType,             requirements = Set.fromList requiredImports,-            mappedDependencies = Set.empty+            mappedDependencies = Set.empty,+            nominalDependencies = Set.empty           }      application constructor requiredImports value =@@ -116,17 +122,39 @@         )         value +    keyedMapType key value =+      RenderedType+        { rendered = "Map " <> argument key <> " " <> argument value,+          precedence = ApplicationType,+          requirements = Set.singleton (ImportRequirement "containers" "Data.Map.Strict" "Map") <> key.requirements <> value.requirements,+          mappedDependencies = key.mappedDependencies <> value.mappedDependencies,+          nominalDependencies = key.nominalDependencies <> value.nominalDependencies+        }+     argument value = case (.precedence) value of       AtomicType -> (.rendered) value       ApplicationType -> "(" <> (.rendered) value <> ")" +    nominalRenderedType leaf = case (.ownership) leaf of+      GeneratedLeaf ->+        RenderedType ((.name) leaf) AtomicType Set.empty Set.empty (Set.singleton ((.name) leaf))+      ConsumerLeaf binding ->+        let source = (.haskell) binding+         in RenderedType+              ((.valueType) source)+              AtomicType+              (Set.singleton (ImportRequirement ((.package) source) ((.moduleName) source) ((.valueType) source)))+              Set.empty+              (Set.singleton ((.name) leaf))+ data TypePrecedence = AtomicType | ApplicationType  data RenderedType = RenderedType   { rendered :: !Text,     precedence :: !TypePrecedence,     requirements :: !(Set ImportRequirement),-    mappedDependencies :: !(Set MappedKey)+    mappedDependencies :: !(Set MappedKey),+    nominalDependencies :: !(Set Text)   }  mappedSource :: ResolvedMappedDecl -> HaskellSource@@ -146,8 +174,8 @@ -- | Render a planned type through the target module's complete deterministic -- 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 :: Text -> HaskellImportPlan -> TypeGraph -> ResolvedTypeExpr -> Either ConsumerTypePlanError HaskellTypeOccurrence+renderConsumerType generatedNominalModule importPlan graph = fmap (HaskellTypeOccurrence . (.rendered)) . render   where     render = \case       RText -> pure (plainAtom "Text")@@ -163,14 +191,33 @@         renderedValue <- render value         pure $           replaceRenderedType ("Map Text " <> argument renderedValue) ApplicationType renderedValue.requirements renderedValue+      RKeyedMap key value -> do+        renderedKey <- render (RNominal key)+        renderedValue <- render value+        pure+          RenderedType+            { rendered = "Map " <> argument renderedKey <> " " <> argument renderedValue,+              precedence = ApplicationType,+              requirements = renderedKey.requirements <> renderedValue.requirements,+              mappedDependencies = renderedKey.mappedDependencies <> renderedValue.mappedDependencies,+              nominalDependencies = renderedKey.nominalDependencies <> renderedValue.nominalDependencies+            }       RRef key -> case Map.lookup key ((.declarations) graph) of         Nothing -> Left (ConsumerTypePlanUnknownDeclaration key)         Just declaration ->           let source = mappedSource declaration            in atom ((.valueType) source) (reference ((.moduleName) source) ((.valueType) source))+      RNominal leaf -> case (.ownership) leaf of+        GeneratedLeaf ->+          atom+            ((.name) leaf)+            (HaskellReference generatedNominalModule ((.name) leaf) TypeNamespace PreferUnqualified)+        ConsumerLeaf binding ->+          let source = (.haskell) binding+           in atom ((.valueType) source) (reference ((.moduleName) source) ((.valueType) source))      atom _ ref = plainAtom <$> plannedReference ref-    plainAtom value = RenderedType value AtomicType Set.empty Set.empty+    plainAtom value = RenderedType value AtomicType Set.empty Set.empty Set.empty     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@@ -185,5 +232,6 @@     { rendered,       precedence,       requirements,-      mappedDependencies = value.mappedDependencies+      mappedDependencies = value.mappedDependencies,+      nominalDependencies = value.nominalDependencies     }
src/Keiro/Dsl/CoordinationImpact.hs view
@@ -12,10 +12,15 @@     CoordinationReason (..),     RouterSelectionSnapshot (..),     RouterSelectionDrift (..),+    ProcessReactionSnapshot (..),+    ProcessReactionDrift (..),     CoordinationImpact (..),     routerSelectionSnapshots,     routerSelectionDrift,     renderRouterSelectionDrift,+    processReactionSnapshots,+    processReactionDrift,+    renderProcessReactionDrift,     coordinationImpact,     renderCoordinationImpact,   )@@ -24,6 +29,7 @@ import Control.Monad (unless) import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.=)) import Data.List (sortOn)+import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe)@@ -32,10 +38,11 @@ import Data.Text qualified as T import GHC.Generics (Generic) import Keiro.Dsl.Grammar+import Keiro.Dsl.ProcessReaction (CheckedProcessReaction (..), checkProcessReaction) import Keiro.Dsl.RouterSelection import Keiro.Dsl.SemanticContract (CheckedService, checkedLanguageContract, checkedSpec, checkedTypeGraph) import Keiro.Dsl.SemanticImpact (MappedConsumer (..), MappedImpactDelta (..))-import Keiro.Dsl.TypeGraph (UsePath (..), UseSite, renderUsePath)+import Keiro.Dsl.TypeGraph (PathSeg (..), UsePath (..), UseSite (..), renderUsePath, unMappedKey) import Numeric.Natural (Natural)  data SelectionVerification = DeclarativeVerified | CustomUnverified@@ -88,6 +95,24 @@   }   deriving stock (Eq, Show, Generic) +-- | Durable coordination metadata for a generated reaction body. Legacy+-- handle bodies are retained as @custom-unverified@ without assigning a+-- version or fingerprint that their source does not declare.+data ProcessReactionSnapshot = ProcessReactionSnapshot+  { process :: !Name,+    verification :: !Text,+    version :: !(Maybe Natural),+    fingerprint :: !(Maybe Text)+  }+  deriving stock (Eq, Ord, Show, Generic)++data ProcessReactionDrift = ProcessReactionDrift+  { process :: !Name,+    previousReaction :: !(Maybe ProcessReactionSnapshot),+    currentReaction :: !(Maybe ProcessReactionSnapshot)+  }+  deriving stock (Eq, Show, Generic)+ instance ToJSON SelectionVerification where   toJSON = toJSON . verificationIdentity @@ -109,6 +134,26 @@         "fingerprint" .= (.fingerprint) snapshot       ] +instance ToJSON ProcessReactionSnapshot where+  toJSON snapshot =+    object+      [ "processName" .= (.process) snapshot,+        "verification" .= (.verification) snapshot,+        "version" .= (.version) snapshot,+        "fingerprint" .= (.fingerprint) snapshot+      ]++instance FromJSON ProcessReactionSnapshot where+  parseJSON = withObject "ProcessReactionSnapshot" $ \fields -> do+    snapshot <-+      ProcessReactionSnapshot+        <$> fields .: "processName"+        <*> fields .: "verification"+        <*> fields .:? "version"+        <*> fields .:? "fingerprint"+    unless (processSnapshotValid snapshot) (fail "process reaction metadata does not match its verification boundary")+    pure snapshot+ instance FromJSON RouterSelectionSnapshot where   parseJSON = withObject "RouterSelectionSnapshot" $ \fields -> do     snapshot <-@@ -135,7 +180,7 @@         "currentVersion" .= (.currentVersion) impact,         "previousFingerprint" .= (.previousFingerprint) impact,         "currentFingerprint" .= (.currentFingerprint) impact,-        "affectedUseSites" .= map (renderUsePath . (`UsePath` [])) ((.affectedUseSites) impact)+        "affectedUseSites" .= map (renderUsePath . useSitePath) ((.affectedUseSites) impact)       ]  -- | Freeze every router's checked coordination metadata in canonical name order.@@ -169,6 +214,59 @@         <> maybe "" ((" version=" <>) . T.pack . show) ((.version) snapshot)         <> maybe "" (" fingerprint=" <>) ((.fingerprint) snapshot) +processReactionSnapshots :: CheckedService -> Either (NE.NonEmpty Text) [ProcessReactionSnapshot]+processReactionSnapshots service = sortOn (.process) <$> traverse snapshotFor processes+  where+    spec = checkedSpec service+    processes = [process | NProcess process <- (.nodes) spec]+    snapshotFor process = case (.body) process of+      LegacyProcessBody {} -> Right (customSnapshot process)+      ReactionProcessBody {} -> case checkedTypeGraph service of+        Left failures -> Left (T.pack ("checked service type graph did not resolve for process coordination: " <> show failures) NE.:| [])+        Right graph -> case checkProcessReaction (checkedLanguageContract service) graph spec process of+          Left failures -> Left (T.pack ("validated process reaction did not check for coordination: " <> show failures) NE.:| [])+          Right checked ->+            Right+              ProcessReactionSnapshot+                { process = (.name) process,+                  verification = (.verification) checked,+                  version = Just ((.version) checked),+                  fingerprint = Just ((.fingerprint) checked)+                }+    customSnapshot process =+      ProcessReactionSnapshot+        { process = (.name) process,+          verification = "custom-unverified",+          version = Nothing,+          fingerprint = Nothing+        }++processReactionDrift :: [ProcessReactionSnapshot] -> [ProcessReactionSnapshot] -> [ProcessReactionDrift]+processReactionDrift previous current =+  [ ProcessReactionDrift process old new+  | process <- Set.toAscList (Map.keysSet oldByProcess <> Map.keysSet newByProcess),+    let old = Map.lookup process oldByProcess,+    let new = Map.lookup process newByProcess,+    old /= new+  ]+  where+    oldByProcess = Map.fromList [((.process) snapshot, snapshot) | snapshot <- previous]+    newByProcess = Map.fromList [((.process) snapshot, snapshot) | snapshot <- current]++renderProcessReactionDrift :: [ProcessReactionDrift] -> [Text]+renderProcessReactionDrift [] = []+renderProcessReactionDrift drifts = "process reaction coordination metadata:" : concatMap renderDrift drifts+  where+    renderDrift drift =+      [ "  " <> (.process) drift,+        "    previous: " <> maybe "(none)" renderSnapshot ((.previousReaction) drift),+        "    current:  " <> maybe "(none)" renderSnapshot ((.currentReaction) drift)+      ]+    renderSnapshot snapshot =+      (.verification) snapshot+        <> maybe "" ((" version=" <>) . T.pack . show) ((.version) snapshot)+        <> maybe "" (" fingerprint=" <>) ((.fingerprint) snapshot)+ coordinationImpact :: CheckedService -> CheckedService -> [MappedImpactDelta] -> [CoordinationImpact] coordinationImpact previous current mappedDeltas =   sortOn impactOrder (directImpacts <> mappedImpacts)@@ -305,14 +403,27 @@     renderMaybe = maybe "(unverified)" id     renderMaybeShow = maybe "(unverified)" (T.pack . show)     renderUseSites [] = "(none)"-    renderUseSites values = T.intercalate ", " (map (renderUsePath . (`UsePath` [])) values)+    renderUseSites values = T.intercalate ", " (map (renderUsePath . useSitePath) values) +useSitePath :: UseSite -> UsePath+useSitePath site = UsePath ((.root) site) [SegDecl (unMappedKey ((.mappedKey) site))]+ snapshotValid :: RouterSelectionSnapshot -> Bool snapshotValid snapshot = case (.verification) snapshot of   DeclarativeVerified -> allPresent   CustomUnverified -> allAbsent   where     fields = [() <$ (.identity) snapshot, () <$ (.version) snapshot, () <$ (.fingerprint) snapshot]+    allPresent = all (/= Nothing) fields+    allAbsent = all (== Nothing) fields++processSnapshotValid :: ProcessReactionSnapshot -> Bool+processSnapshotValid snapshot = case (.verification) snapshot of+  "generated-declarative" -> allPresent+  "custom-unverified" -> allPresent || allAbsent+  _ -> False+  where+    fields = [() <$ (.version) snapshot, () <$ (.fingerprint) snapshot]     allPresent = all (/= Nothing) fields     allAbsent = all (== Nothing) fields
src/Keiro/Dsl/Coverage.hs view
@@ -12,6 +12,7 @@     StructuralBoundary (..),     OpaqueBoundary (..),     JsonBoundary (..),+    NominalBoundary (..),     SnapshotBoundary (..),     UnsupportedSurface (..),     CoverageCounts (..),@@ -100,6 +101,19 @@   }   deriving stock (Eq, Ord, Show) +data NominalBoundary = NominalBoundary+  { root :: !Text,+    path :: !Text,+    position :: !Text,+    nominal :: !Text,+    kind :: !Text,+    prefix :: !(Maybe Text),+    domainVersion :: !(Maybe Text),+    canonicalType :: !(Maybe Text),+    ownership :: !Text+  }+  deriving stock (Eq, Ord, Show)+ data SnapshotBoundary = SnapshotBoundary   { root :: !Text,     aggregate :: !Text,@@ -174,6 +188,7 @@     structuralBoundaries :: ![StructuralBoundary],     opaqueBoundaries :: ![OpaqueBoundary],     jsonBoundaries :: ![JsonBoundary],+    nominalBoundaries :: ![NominalBoundary],     snapshotBoundaries :: ![SnapshotBoundary],     unsupportedSurfaces :: ![UnsupportedSurface],     summary :: !CoverageSummary,@@ -191,10 +206,14 @@   graph <- checkedTypeGraph service   let spec = checkedSpec service   let impact = semanticImpact graph-      roots = sortOn (\root -> ((.path) root, (.consumer) root, (.surface) root)) (map (coverageRoot graph) ((.roots) impact))+      roots =+        sortOn+          (\root -> ((.path) root, (.consumer) root, (.surface) root))+          (map (coverageRoot graph) ((.roots) impact) <> map (coverageNominalRoot graph) (filter coverageOwnedNominalRoot ((.nominalRootSites) graph)))       structural = structuralBoundaryInventory graph       opaque = opaqueBoundaryInventory graph       json = sortOn (.path) (jsonBoundaryInventory graph <> queueExplicitJsonBoundaries spec)+      nominals = nominalBoundaryInventory graph       snapshots = snapshotBoundaryInventory spec graph       summary = summarize roots json       findings = opaqueSurfaceFindings opaque@@ -205,6 +224,7 @@         structuralBoundaries = structural,         opaqueBoundaries = opaque,         jsonBoundaries = json,+        nominalBoundaries = nominals,         snapshotBoundaries = snapshots,         unsupportedSurfaces = unsupportedInventory graph,         summary = summary,@@ -286,6 +306,7 @@       structuralBoundaries = report.structuralBoundaries,       opaqueBoundaries = report.opaqueBoundaries,       jsonBoundaries = report.jsonBoundaries,+      nominalBoundaries = report.nominalBoundaries,       snapshotBoundaries = report.snapshotBoundaries,       unsupportedSurfaces = report.unsupportedSurfaces,       summary = report.summary,@@ -350,7 +371,7 @@   Aeson.encodeFile path report  persistedSites :: TypeGraph -> [UseSite]-persistedSites = filter isPersisted . (.useSites)+persistedSites = filter (isPersisted . (.root)) . (.useSites)   where     isPersisted RootEventField {} = True     isPersisted RootRegister {} = True@@ -358,12 +379,19 @@     isPersisted RootWorkqueueField {} = True     isPersisted RootReadModelQueryInput {} = False     isPersisted RootReadModelQueryResult {} = False+    isPersisted RootContractField {} = False +coverageOwnedNominalRoot :: NominalRootSite -> Bool+coverageOwnedNominalRoot site = case (.root) site of+  RootContractField {} -> False+  _ -> True+ coverageRoot :: TypeGraph -> MappedRoot -> CoverageRoot coverageRoot graph mappedRoot =-  let site = (.useSite) mappedRoot+  let site :: UseSite+      site = (.useSite) mappedRoot       key = (.declaration) mappedRoot-      path = renderUsePath (UsePath site (useSiteSegments graph site))+      path = renderUsePath (UsePath ((.root) site) ([SegDecl (unMappedKey key)] <> useSiteSegments graph site))       fingerprint = wireFingerprint graph (unMappedKey key)    in case Map.lookup key ((.declarations) graph) of         Just (ResolvedStructural declaration _) ->@@ -392,6 +420,23 @@             }         Nothing -> error "coverageRoot: resolved use-site key missing from graph" +coverageNominalRoot :: TypeGraph -> NominalRootSite -> CoverageRoot+coverageNominalRoot graph site =+  case Map.lookup ((.nominal) site) ((.nominalLeaves) graph) of+    Nothing -> error "coverageNominalRoot: resolved nominal use-site missing from graph"+    Just leaf ->+      CoverageRoot+        { surface = rootRefSurface ((.root) site),+          consumer = nominalRootConsumer ((.root) site),+          path = renderUsePath (UsePath ((.root) site) ([SegNominal ((.nominal) site)] <> (.segments) site)),+          mappedType = (.nominal) site,+          mode = StructuralCoverage,+          canonicalType = case (.ownership) leaf of GeneratedLeaf -> Nothing; ConsumerLeaf binding -> Just (unCanonicalTypeId ((.canonical) binding)),+          codecIdentity = Nothing,+          codecVersion = Nothing,+          wireFingerprint = nominalWireFingerprint leaf+        }+ structuralBoundaryInventory :: TypeGraph -> [StructuralBoundary] structuralBoundaryInventory graph =   sortOn@@ -424,22 +469,42 @@       isWireSite ((.root) path)     ] +nominalBoundaryInventory :: TypeGraph -> [NominalBoundary]+nominalBoundaryInventory graph =+  sortOn+    (.path)+    [ NominalBoundary+        { root = rootText ((.root) path),+          path = renderUsePath path,+          position = if SegMapKey `elem` (.segments) path then "key" else "value",+          nominal = (.name) leaf,+          kind = case (.kind) leaf of NominalIdLeaf {} -> "id"; NominalEnumLeaf {} -> "enum"; NominalScalarLeaf {} -> "scalar",+          prefix = case (.kind) leaf of NominalIdLeaf value -> Just value; NominalEnumLeaf {} -> Nothing; NominalScalarLeaf {} -> Nothing,+          domainVersion = case (.kind) leaf of NominalIdLeaf {} -> Just "keiro-dsl/id-domain/typeid-v7/1"; NominalEnumLeaf {} -> Nothing; NominalScalarLeaf {} -> Nothing,+          canonicalType = case (.ownership) leaf of GeneratedLeaf -> Nothing; ConsumerLeaf binding -> Just (unCanonicalTypeId ((.canonical) binding)),+          ownership = case (.ownership) leaf of GeneratedLeaf -> "generated"; ConsumerLeaf {} -> "consumer"+        }+    | leaf <- Map.elems ((.nominalLeaves) graph),+      path <- nominalUsePaths graph ((.name) leaf),+      isWireSite ((.root) path)+    ]+ jsonBoundaryInventory :: TypeGraph -> [JsonBoundary] jsonBoundaryInventory graph =   sortOn     (.path)     [ boundary site completeSegments     | site <- persistedSites graph,-      isWireSite site,+      isWireSite ((.root) site),       segments <- jsonPathsFromDecl graph Set.empty (useSiteKey site),-      let completeSegments = useSiteSegments graph site <> segments+      let completeSegments = [SegDecl (unMappedKey (useSiteKey site))] <> useSiteSegments graph site <> segments     ]   where     boundary site segments =       JsonBoundary         { surface = useSiteSurface site,-          root = rootText site,-          path = renderUsePath (UsePath site segments)+          root = rootText ((.root) site),+          path = renderUsePath (UsePath ((.root) site) segments)         }  queueExplicitJsonBoundaries :: Spec -> [JsonBoundary]@@ -460,35 +525,53 @@     explicitJsonPaths (TOptional value) = map (SegOptional :) (explicitJsonPaths value)     explicitJsonPaths (TList value) = map (SegElem :) (explicitJsonPaths value)     explicitJsonPaths (TMap value) = map (SegMapValue :) (explicitJsonPaths value)+    explicitJsonPaths (TKeyedMap _ value) = map (SegMapValue :) (explicitJsonPaths value)     explicitJsonPaths _ = []     renderSegments = T.concat . map renderSegment     renderSegment SegOptional = " optional"     renderSegment SegElem = " []"+    renderSegment SegMapKey = " {key}"     renderSegment SegMapValue = " {}"     renderSegment (SegField name key)       | name == key = " ." <> name       | otherwise = " ." <> name <> " as " <> T.pack (show key)     renderSegment (SegArm _ tag) = " arm " <> T.pack (show tag)     renderSegment (SegDecl name) = " : " <> name+    renderSegment (SegNominal name) = " : " <> name  snapshotBoundaryInventory :: Spec -> TypeGraph -> [SnapshotBoundary] snapshotBoundaryInventory spec graph =   sortOn     (.root)-    [ SnapshotBoundary-        { 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 ((.declarations) graph)]-    ]+    ( [ SnapshotBoundary+          { root = renderUsePath (UsePath ((.root) site) [SegDecl (unMappedKey key)]),+            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@UseSite {root = RootRegister aggregate register, mappedKey = key} <- persistedSites graph,+        Just declaration <- [Map.lookup key ((.declarations) graph)]+      ]+        <> [ SnapshotBoundary+               { root = renderUsePath (UsePath ((.root) site) ([SegNominal ((.nominal) site)] <> (.segments) site)),+                 aggregate = aggregate,+                 register = register,+                 mappedType = (.nominal) site,+                 mode = StructuralCoverage,+                 encoding = "consumer-json-cache",+                 invalidation = "tracked-by-nominal-wire-fingerprint",+                 wireFingerprint = nominalWireFingerprint leaf,+                 enabled = aggregateHasSnapshot aggregate+               }+           | site@NominalRootSite {root = RootRegister aggregate register} <- (.nominalRootSites) graph,+             Just leaf <- [Map.lookup ((.nominal) site) ((.nominalLeaves) graph)]+           ]+    )   where     aggregateHasSnapshot name =       any@@ -539,7 +622,9 @@         onOptional = map (SegOptional :),         onList = map (SegElem :),         onMap = map (SegMapValue :),-        onRef = \key -> map (SegDecl (unMappedKey key) :) (jsonPathsFromDecl graph visited key)+        onKeyedMap = \_ -> map (SegMapValue :),+        onRef = \key -> map (SegDecl (unMappedKey key) :) (jsonPathsFromDecl graph visited key),+        onNominal = const []       }  summarize :: [CoverageRoot] -> [JsonBoundary] -> CoverageSummary@@ -604,21 +689,20 @@     unsupportedProjectionIdentity (UnsupportedCatalogAll owner) = "projection-all:" <> owner  useSiteKey :: UseSite -> MappedKey-useSiteKey (RootCommandField _ _ _ key) = key-useSiteKey (RootEventField _ _ _ key) = key-useSiteKey (RootRegister _ _ key) = key-useSiteKey (RootWorkqueueField _ _ key) = key-useSiteKey (RootReadModelQueryInput _ key) = key-useSiteKey (RootReadModelQueryResult _ key) = key+useSiteKey = (.mappedKey)  useSiteSurface :: UseSite -> CoverageSurface-useSiteSurface RootCommandField {} = AggregateCommandPayload-useSiteSurface RootEventField {} = PrivateEventPayload-useSiteSurface RootRegister {} = SnapshotRegister-useSiteSurface RootWorkqueueField {} = WorkqueuePayload-useSiteSurface RootReadModelQueryInput {} = ReadModelQueryInput-useSiteSurface RootReadModelQueryResult {} = ReadModelQueryResult+useSiteSurface = rootRefSurface . (.root) +rootRefSurface :: RootRef -> CoverageSurface+rootRefSurface RootCommandField {} = AggregateCommandPayload+rootRefSurface RootEventField {} = PrivateEventPayload+rootRefSurface RootRegister {} = SnapshotRegister+rootRefSurface RootWorkqueueField {} = WorkqueuePayload+rootRefSurface RootReadModelQueryInput {} = ReadModelQueryInput+rootRefSurface RootReadModelQueryResult {} = ReadModelQueryResult+rootRefSurface RootContractField {} = error "public contracts have a separately owned coverage surface"+ rootKindSurface :: MappedRootKind -> CoverageSurface rootKindSurface MappedCommandFieldRoot = AggregateCommandPayload rootKindSurface MappedEventFieldRoot = PrivateEventPayload@@ -632,17 +716,28 @@ rootKindSurface MappedRouterSelectionCommandFieldRoot = ReadModelQueryResult rootKindSurface MappedProjectionEventRoot = ProjectionTypedConsumer -isWireSite :: UseSite -> Bool+isWireSite :: RootRef -> Bool isWireSite RootEventField {} = True isWireSite RootWorkqueueField {} = True isWireSite RootRegister {} = False isWireSite RootCommandField {} = False isWireSite RootReadModelQueryInput {} = False isWireSite RootReadModelQueryResult {} = False+isWireSite RootContractField {} = False -rootText :: UseSite -> Text+rootText :: RootRef -> Text rootText site = renderUsePath (UsePath site []) +nominalRootConsumer :: RootRef -> Text+nominalRootConsumer = \case+  RootCommandField aggregate _ _ -> aggregate+  RootEventField aggregate _ _ -> aggregate+  RootRegister aggregate _ -> aggregate+  RootWorkqueueField workqueue _ -> "workqueue:" <> workqueue+  RootReadModelQueryInput readModel -> "read-model-query:" <> readModel <> ":input"+  RootReadModelQueryResult readModel -> "read-model-query:" <> readModel <> ":result"+  RootContractField {} -> error "public contracts have a separately owned coverage surface"+ declarationMode :: ResolvedMappedDecl -> CoverageMode declarationMode =   foldMappedDecl@@ -664,6 +759,20 @@   toJSON StructuralCoverage = toJSON ("structural" :: Text)   toJSON OpaqueCoverage = toJSON ("opaque" :: Text) +instance ToJSON NominalBoundary where+  toJSON boundary =+    object+      [ "root" .= (.root) boundary,+        "path" .= (.path) boundary,+        "position" .= (.position) boundary,+        "nominal" .= (.nominal) boundary,+        "kind" .= (.kind) boundary,+        "prefix" .= (.prefix) boundary,+        "domainVersion" .= (.domainVersion) boundary,+        "canonicalType" .= (.canonicalType) boundary,+        "ownership" .= (.ownership) boundary+      ]+ instance ToJSON CoverageRoot where   toJSON root =     object@@ -791,6 +900,7 @@         "structuralBoundaries" .= (.structuralBoundaries) report,         "opaqueBoundaries" .= (.opaqueBoundaries) report,         "jsonBoundaries" .= (.jsonBoundaries) report,+        "nominalBoundaries" .= (.nominalBoundaries) report,         "snapshotBoundaries" .= (.snapshotBoundaries) report,         "unsupportedSurfaces" .= (.unsupportedSurfaces) report,         "summary" .= (.summary) report,
src/Keiro/Dsl/Diff.hs view
@@ -59,15 +59,16 @@  import Data.Char (toUpper) import Data.Foldable (traverse_)-import Data.List (find, sort, (\\))+import Data.List (find, nub, sort, sortOn, (\\))+import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as Map-import Data.Maybe (isJust, isNothing, mapMaybe, maybeToList)+import Data.Maybe (fromMaybe, 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.CanonicalEncoding (canonicalDomainOutcomeTypes, canonicalExpr, canonicalTransition, canonicalTransitionOutcome) import Keiro.Dsl.FieldIdentity   ( ResolvedFieldIdentity (..),     resolveAggregateFieldIdentity,@@ -77,23 +78,31 @@ 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.LanguageVersion (ParsedSource (..), SourceLanguage (..), declaredLanguageVersionMaybe, languageVersionText, renderParseFailure, sourceFormText) import Keiro.Dsl.MappedDiff (MappedFinding (..), diffMapped, renderMappedSubject)+import Keiro.Dsl.Parser (parseSource) import Keiro.Dsl.PrettyPrint   ( renderHandleSurface,+    renderReactionArmBodySurface,+    renderReactionArmGuardSurface,+    renderReactionArmSurface,+    renderReactionTimerPayloadSurface,     renderResolveSurface,     renderRouterDispatchSurface,+    renderSource,     renderTimerPayloadSurface,     renderTransition,     renderTypeExpr,   )+import Keiro.Dsl.ProcessReaction (processReactionFingerprintFrom) 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.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedServiceWithSpec, 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 (..))+import Keiro.Dsl.TransitionFamily (ReplayBodyDelta (..), ReplayBodyKey, ReplayBodyStatus (..), TransitionFamilyKey (..), guardAlternatives, guardImplies, guardUnion, replayBodyDeltas, replayBodyKey)+import Keiro.Dsl.TypeGraph (DerivedMappedConsumer (..), MappedKey (..), PathSeg (..), RootRef (..), UsePath (..), nominalUsePaths, renderUsePath, resolveTypeGraph)+import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode (..), Severity (..), renderDiagnostic, validateService)  -- | A classified spec change. data Change@@ -374,10 +383,15 @@   | code == NominalBindingChanged = mappedBindingVector context   | code `elem` [NominalInitialChanged, NominalCanonicalTypeChanged] = mappedSnapshotBuildVector context   | code == NominalRepresentationChanged = mappedWireBreakingVector context+  | code == IdPrefixChanged && (.contextKind) context /= ContextGeneral = mappedWireBreakingVector context   | code == NominalIdDecoderTightened =       replaceConsumerBuild VAdvisory (advisoryVector PrivateHistoryRead Set.empty)   | code == ContractTypeIdDomainChanged = contractTypeIdDomainVector-  | code == IdDomainContractChanged = idDomainContractVector+  | code == ContractFieldChanged && (.contextKind) context == ContextConsumerBuild = mappedBuildVector+  | code == IdDomainContractChanged =+      if (.contextKind) context == ContextGeneral+        then idDomainContractVector+        else idDomainBoundaryVector context   | code == MappedDeclAdded = compatibleVector   | code `elem` privateDecodeCodes = privateDecodeBreakingVector   | code `elem` identityCodes = persistedIdentityBreakingVector@@ -393,9 +407,17 @@   | code == ContractSchemaVersionBumped = advisoryVector PublicConsumer (Set.singleton RolloutProducerLast)   | code == AggFoldSurfaceChanged =       replaceSnapshotHydration VAdvisory (advisoryVector PrivateHistoryRead Set.empty)-  | code == AggGuardTightened = advisoryVector PrivateHistoryRead Set.empty+  | code `elem` [AggGuardTightened, AggGuardRelationUnknown, AggGuardRemedyUnavailable] = advisoryVector PrivateHistoryRead Set.empty   | code `elem` [RouterDecideSurfaceChanged, ProcessDecideSurfaceChanged] =       replaceRollout (Set.singleton RolloutDrainRequired) compatibleVector+  | code+      `elem` [ ProcessReactionFanOutChanged,+               ProcessReactionGuardChanged,+               ProcessReactionArmsReordered,+               ProcessReactionRemoved,+               ProcessReactionFingerprintChangedWithVersionBump+             ] =+      replaceRollout (Set.singleton RolloutDrainRequired) (advisoryVector PrivateHistoryRead Set.empty)   | code == ProcessTimerPayloadChanged = advisoryVector PrivateHistoryRead (Set.singleton RolloutProducerLast)   | code == TimerWindowChanged = advisoryVector PrivateHistoryRead Set.empty   | code == ProjectionChanged = advisoryVector PersistedIdentity Set.empty@@ -439,8 +461,14 @@       [ DerivedIdentityChanged,         IdPrefixChanged,         DedupeIdentityChanged,+        IntakeIdempotenceModeChanged,         QueueIdentityChanged,         RouterStableNameChanged,+        ProcessDispatchIdentityModelChanged,+        ProcessTimerIdentityChanged,+        ProcessTimerRemoved,+        ProcessReactionVersionDecreased,+        ProcessReactionFingerprintChangedWithoutVersionBump,         WorkflowStableNameChanged       ]     publicBreakingCodes =@@ -558,6 +586,7 @@       (Set.singleton RolloutStopTheWorld)   ContextSnapshot -> mappedSnapshotVector   ContextQueue -> queueBreakingVector+  ContextPublicContract -> publicBreakingVector   ContextConsumerBuild -> mappedBuildVector   _ -> mappedBuildVector @@ -597,6 +626,7 @@   ContextSnapshot ->     replaceConsumerBuild VAdvisory mappedSnapshotVector   ContextQueue -> queueBreakingVector+  ContextPublicContract -> publicBreakingVector   _ -> mappedBuildVector  mappedSnapshotBuildVector :: ChangeContext -> CompatibilityVector@@ -604,6 +634,15 @@   ContextSnapshot -> replaceConsumerBuild VAdvisory mappedSnapshotVector   _ -> mappedBuildVector +idDomainBoundaryVector :: ChangeContext -> CompatibilityVector+idDomainBoundaryVector context = case (.contextKind) context of+  ContextPrivateEvent -> mappedBuildVector+  ContextSnapshot -> replaceConsumerBuild VAdvisory mappedSnapshotVector+  ContextQueue -> queueBreakingVector+  ContextPublicContract -> publicBreakingVector+  ContextConsumerBuild -> mappedBuildVector+  _ -> mappedBuildVector+ surfaceForContext :: ChangeContext -> CompatibilitySurface surfaceForContext context = case (.contextKind) context of   ContextPrivateEvent -> PrivateHistoryRead@@ -667,7 +706,10 @@ -- | Both specs supplied to a node-family differ, always old then new. data DiffEnv = DiffEnv   { old :: !Spec,-    new :: !Spec+    new :: !Spec,+    oldService :: !CheckedService,+    newService :: !CheckedService,+    newValidationErrors :: ![Diagnostic]   }   deriving stock (Eq, Show) @@ -780,30 +822,33 @@   traverse_ (aggregateFoldSurfaceForService oldService . snd) oldAggregates   traverse_ (aggregateFoldSurfaceForService newService . snd) newAggregates   semanticContractFoldChanges <- fmap concat (traverse semanticContractFoldChange oldAggregates)-  pure (diffCheckedSpecs oldSpec newSpec <> idDomainContractChanges <> contractTypeIdDomainChanges <> semanticContractFoldChanges)+  pure (diffCheckedSpecs oldService newService <> 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-      ]+      concat+        [ breaking+            ((.name) newDeclaration)+            "id-domain-contract"+            ((.name) newDeclaration)+            IdDomainContractChanged+            detail+            : [nominalUseChange use IdDomainContractChanged detail | use <- nominalBoundaryUses oldSpec newSpec ((.name) newDeclaration)]+        | 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,+          let detail =+                "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"+        ]     contractTypeIdDomainChanges =       [ breaking           ((.name) newContract)@@ -811,6 +856,7 @@           ((.name) newEvent <> "." <> (.name) newField)           ContractTypeIdDomainChanged           ( renderContractIdDomainChange+              (contractTypePrefix newSpec ((.valueType) newField))               ((.valueType) newField)               oldContract               newContract'@@ -822,8 +868,8 @@         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,+        let oldContract = contractFieldIdDomain oldSpec (checkedLanguageContract oldService) oldField,+        let newContract' = contractFieldIdDomain newSpec (checkedLanguageContract newService) newField,         oldContract /= newContract'       ]     semanticContractFoldChange (name, oldAggregate) = case lookup name newAggregates of@@ -849,13 +895,14 @@ renderIdDomainContract (Just contract) =   idDomainVersion contract <> "(prefix=" <> idDomainPrefix contract <> ",json=" <> idDomainJsonRepresentation contract <> ")" -contractFieldIdDomain :: EffectiveLanguageContract -> ContractField -> Maybe IdDomainContract-contractFieldIdDomain languageContract field = case (.valueType) field of+contractFieldIdDomain :: Spec -> EffectiveLanguageContract -> ContractField -> Maybe IdDomainContract+contractFieldIdDomain spec languageContract field = case (.valueType) field of   CTypeId prefix -> contractIdDomainContractFor languageContract prefix+  CDeclaredId name -> contractTypePrefix spec (CDeclaredId name) >>= contractIdDomainContractFor languageContract   _ -> Nothing -renderContractIdDomainChange :: ContractType -> Maybe IdDomainContract -> Maybe IdDomainContract -> Text-renderContractIdDomainChange valueType oldContract newContract =+renderContractIdDomainChange :: Maybe Text -> ContractType -> Maybe IdDomainContract -> Maybe IdDomainContract -> Text+renderContractIdDomainChange resolvedPrefix valueType oldContract newContract =   "contract TypeID admission changed "     <> renderIdDomainContract oldContract     <> " -> "@@ -864,6 +911,7 @@   where     prefix = case valueType of       CTypeId value -> value+      CDeclaredId _ -> fromMaybe "" resolvedPrefix       _ -> ""     representationChange = case (oldContract, newContract) of       (Nothing, Just _) ->@@ -876,12 +924,19 @@           <> "\" 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 =+diffCheckedSpecs :: CheckedService -> CheckedService -> [Change]+diffCheckedSpecs oldService newService =   sharedDeclarationDiff env     ++ concatMap (runFamily env . snd) familyRegistry   where-    env = DiffEnv old new+    env =+      DiffEnv+        { old = checkedSpec oldService,+          new = checkedSpec newService,+          oldService,+          newService,+          newValidationErrors = filter ((== Error) . (.severity)) (validateService newService)+        }  -- | Compare provenance first, then delegate semantic graphs to 'diffServices'. diffSources :: ParsedSource -> ParsedSource -> Either FoldSurfaceError [Change]@@ -1073,22 +1128,24 @@   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)+      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)+      RootContractField contract _ _ -> (contract, "mapped-contract", ContextPublicContract)     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]+  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]+  RootContractField {} -> []  withMappedConsequences :: Set MappedConsequence -> Change -> Change withMappedConsequences consequences = \case@@ -1651,23 +1708,23 @@ aggregateDiff :: DiffEnv -> [Change] aggregateDiff env =   concatMap-    (\(oldAggregate, newAggregate) -> aggregatePairDiff ((.old) env) ((.new) env) oldAggregate newAggregate)+    (uncurry (aggregatePairDiff env))     ((.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 =+aggregatePairDiff :: DiffEnv -> Aggregate -> Aggregate -> [Change]+aggregatePairDiff env oldAgg newAgg =   commandFieldIdentityDiff oldAgg newAgg     ++ concatMap (eventDiff oldAgg newAgg) ((.events) newAgg)     ++ removedEvents oldAgg newAgg     ++ wireDiff oldAgg newAgg     ++ projectionDiff oldAgg newAgg-    ++ guardTighteningDiff oldAgg newAgg+    ++ guardTighteningDiff env oldAgg newAgg     ++ domainOutcomeDiff oldAgg newAgg-    ++ transitionSurfaceDiff oldSpec newSpec oldAgg newAgg+    ++ transitionSurfaceDiff ((.old) env) ((.new) env) 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@@ -1742,24 +1799,92 @@ -- 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 =+data GuardProposal = GuardProposal+  { proposalBody :: !ReplayBodyDelta,+    proposalTwin :: !Transition+  }+  deriving stock (Eq, Show)++guardTighteningDiff :: DiffEnv -> Aggregate -> Aggregate -> [Change]+guardTighteningDiff env oldAgg newAgg = concatMap classifyFamily (Map.toAscList familyBodies)+  where+    familyBodies =+      Map.fromListWith+        (flip (<>))+        [ ((.bodyFamilyKey) bodyDelta, [bodyDelta])+        | bodyDelta <- replayBodyDeltas oldAgg.transitions newAgg.transitions,+          (.familyMode) ((.bodyFamilyKey) bodyDelta) == TmLive+        ]++    allProposals = concatMap proposalsForFamily (Map.elems familyBodies)+    proposalResults = validateGuardProposals env ((.name) newAgg) allProposals++    classifyFamily (key, bodyDeltas)+      | opaqueFamily bodyDeltas = [unknownFinding key bodyDeltas]+      | otherwise = concatMap renderProposal (proposalsForFamily bodyDeltas)++    proposalsForFamily bodyDeltas+      | opaqueFamily bodyDeltas = []+      | otherwise = mapMaybe proposalForBody bodyDeltas++    proposalForBody bodyDelta+      | (.bodyStatus) bodyDelta `notElem` [ReplayBodyChanged, ReplayBodyRemoved] = Nothing+      | otherwise = do+          oldMembers <- NE.nonEmpty (sortOn canonicalTransition ((.oldBodyMembers) bodyDelta))+          let oldUnion = bodyGuardUnion (NE.toList oldMembers)+              newUnion = bodyGuardUnion ((.newBodyMembers) bodyDelta)+              twinGuard = case (.bodyStatus) bodyDelta of+                ReplayBodyRemoved -> oldUnion+                ReplayBodyChanged ->+                  case newUnion of+                    Nothing -> oldUnion+                    Just newGuard -> Just (maybe (complementExpr newGuard) (\oldGuard -> EAnd oldGuard (complementExpr newGuard)) oldUnion)+                _ -> oldUnion+              twin = replaceTransitionGuardAndMode twinGuard TmReplayOnly (NE.head oldMembers)+          if coveredByCandidate bodyDelta newUnion twin+            then Nothing+            else Just GuardProposal {proposalBody = bodyDelta, proposalTwin = twin}++    coveredByCandidate bodyDelta newUnion twin =+      null ((.newValidationErrors) env)+        && any coversBody candidateReplayBodies+      where+        candidateReplayBodies =+          [ transition+          | transition <- (.transitions) newAgg,+            (.mode) transition == TmReplayOnly,+            replayBodyKey transition == (.bodyKey) bodyDelta+          ]+        oldAlternatives =+          NE.toList+            (guardAlternatives (NE.fromList (map (.guard) ((.oldBodyMembers) bodyDelta))))+        coversBody transition =+          guardsCanonicalEqual ((.guard) transition) ((.guard) twin)+            || all (\oldGuard -> guardImplies oldGuard ((.guard) transition)) oldAlternatives+            || all (\oldGuard -> guardImplies oldGuard (unionWith ((.guard) transition))) oldAlternatives+        unionWith replayGuard = case (newUnion, replayGuard) of+          (Nothing, _) -> Nothing+          (_, Nothing) -> Nothing+          (Just live, Just replay) -> Just (EOr live replay)++    renderProposal proposal =+      case Map.lookup (canonicalTransition ((.proposalTwin) proposal)) proposalResults of+        Just (Left reason) ->+          [ advisory ((.name) newAgg) "transition" subject AggGuardRemedyUnavailable (unavailableDetail reason)+          ]+        _ ->+          [ advisory ((.name) newAgg) "transition" subject AggGuardTightened (tightenedDetail ((.proposalTwin) proposal))+          ]+      where+        familyKey = (.bodyFamilyKey) ((.proposalBody) proposal)+        subject = familySubject familyKey+        unavailableDetail reason =+          "guard history may no longer invert on "+            <> subject+            <> ", but the computed replay-only remedy could not be advertised because its candidate-language proof failed: "+            <> reason+            <> ". Resolve the source error or run the targeted replay audit before deployment."+        tightenedDetail twin =           "guard changed on "             <> subject             <> ". Stored events appended under the old guard may no longer invert: "@@ -1769,13 +1894,197 @@             <> "adding the computed replay-only twin (the removed region with the old "             <> "transition's writes/emits/goto):\n\n"             <> renderTransition twin-  ]++    unknownFinding key bodyDeltas =+      advisory ((.name) newAgg) "transition-family" (familySubject key) AggGuardRelationUnknown detail+      where+        oldCount = sum (map (length . (.oldBodyMembers)) bodyDeltas)+        newCount = sum (map (length . (.newBodyMembers)) bodyDeltas)+        detail =+          "guard relationship is opaque for aggregate '"+            <> (.name) newAgg+            <> "' transition family "+            <> familySubject key+            <> ": affected replay bodies contain "+            <> T.pack (show oldCount)+            <> " old and "+            <> T.pack (show newCount)+            <> " new transitions with Hole-owned behavior or a generated/Hole ownership switch. No replay-only transition was generated because Hole behavior cannot be copied or proved covered from its structural envelope; resolve the ownership ambiguity or run the targeted replay audit before deployment."++    opaqueFamily bodyDeltas = oldOpaque || ownershipSwitch+      where+        oldMembers = concatMap (.oldBodyMembers) bodyDeltas+        newMembers = concatMap (.newBodyMembers) bodyDeltas+        oldOpaque = any ((== HoleImplementation) . (.implementation)) oldMembers+        ownershipSwitch =+          or+            [ (.implementation) oldTransition /= (.implementation) newTransition+                && ( (.implementation) oldTransition == HoleImplementation+                       || (.implementation) newTransition == HoleImplementation+                   )+            | oldTransition <- oldMembers,+              newTransition <- newMembers,+              ownershipNeutralBodyKey oldTransition == ownershipNeutralBodyKey newTransition+            ]++    familySubject key = (.familySource) key <> " -- " <> (.familyCommand) key++bodyGuardUnion :: [Transition] -> Maybe Expr+bodyGuardUnion transitions = guardUnion (NE.fromList (map (.guard) transitions))++guardsCanonicalEqual :: Maybe Expr -> Maybe Expr -> Bool+guardsCanonicalEqual left right = maybe "" canonicalExpr left == maybe "" canonicalExpr right++ownershipNeutralBodyKey :: Transition -> ReplayBodyKey+ownershipNeutralBodyKey transition = replayBodyKey (replaceTransitionImplementation GeneratedImplementation transition)++replaceTransitionImplementation :: TransitionImplementation -> Transition -> Transition+replaceTransitionImplementation implementation transition =+  Transition+    { source = transition.source,+      command = transition.command,+      implementation,+      guard = transition.guard,+      writes = transition.writes,+      emits = transition.emits,+      outcome = transition.outcome,+      outcomeDuplicateLocs = transition.outcomeDuplicateLocs,+      goto = transition.goto,+      mode = transition.mode,+      loc = transition.loc+    }++validateGuardProposals :: DiffEnv -> Name -> [GuardProposal] -> Map.Map Text (Either Text ())+validateGuardProposals _ _ [] = Map.empty+validateGuardProposals env aggregateName proposals =+  Map.fromList+    [ (canonicalTransition ((.proposalTwin) proposal), resultFor proposal)+    | proposal <- proposals+    ]   where-    hasReplayOnlyTwin newT =-      any-        (\t -> (.mode) t == TmReplayOnly && (.source) t == (.source) newT && (.command) t == (.command) newT)-        ((.transitions) newAgg)+    twins = map (.proposalTwin) proposals+    preflight = validateGuardRoundTrip env aggregateName []+    combined = validateGuardRoundTrip env aggregateName twins +    resultFor proposal = do+      preflight+      validateGuardRoundTrip env aggregateName [(.proposalTwin) proposal]+      combined++validateGuardRoundTrip :: DiffEnv -> Name -> [Transition] -> Either Text ()+validateGuardRoundTrip env aggregateName twins = do+  let modifiedSpec = appendGuardTwins aggregateName twins ((.new) env)+      modifiedService = checkedServiceWithSpec modifiedSpec ((.newService) env)+      contract = checkedLanguageContract modifiedService+      fullErrors = filter ((== Error) . (.severity)) (validateService modifiedService)+      roundTripSpec = guardRoundTripSpec aggregateName modifiedSpec+      syntheticSource =+        ParsedSource+          { sourceLanguage =+              DeclaredLanguage+                { declaredLanguageVersion = contract.contractLanguageVersion,+                  languageVersionLoc = noLoc+                },+            spec = roundTripSpec+          }+  if null fullErrors+    then pure ()+    else Left ("source validation failed: " <> T.intercalate " | " (map (renderDiagnostic "<guard-remedy>") fullErrors))+  parsed <-+    case parseSource "<guard-remedy>" (renderSource syntheticSource) of+      Left failure -> Left ("render/parse failed: " <> renderParseFailure failure)+      Right value -> Right value+  let parsedService = checkedSource parsed+      errors = filter ((== Error) . (.severity)) (validateService parsedService)+  if checkedLanguageContract parsedService /= contract+    then Left "render/parse selected a different effective language contract"+    else pure ()+  if null errors+    then pure ()+    else Left ("source validation failed: " <> T.intercalate " | " (map (renderDiagnostic "<guard-remedy>") errors))+  if checkedSpec parsedService == roundTripSpec+    then pure ()+    else Left "render/parse changed the normalized affected-aggregate specification"+  let parsedTransitions =+        [ transition+        | NAggregate aggregate <- (.nodes) (checkedSpec parsedService),+          (.name) aggregate == aggregateName,+          transition <- (.transitions) aggregate+        ]+  traverse_+    ( \twin ->+        if any (preservesTwin twin) parsedTransitions+          then Right ()+          else Left ("render/parse did not preserve replay identity for " <> (.source) twin <> " -- " <> (.command) twin)+    )+    twins+  where+    preservesTwin twin parsedTransition =+      canonicalTransition parsedTransition == canonicalTransition twin+        && isNothing ((.outcome) parsedTransition)+        && null ((.outcomeDuplicateLocs) parsedTransition)++-- A composed workspace graph is not itself one source member: its node order+-- may interleave declarations that can only appear before an aggregate. Keep+-- the full graph for validation, but round-trip the affected aggregate with+-- the candidate's complete type-declaration environment.+guardRoundTripSpec :: Name -> Spec -> Spec+guardRoundTripSpec aggregateName spec =+  Spec+    { context = spec.context,+      moduleRoot = spec.moduleRoot,+      layout = spec.layout,+      ids = spec.ids,+      enums = spec.enums,+      rules = spec.rules,+      nominalScalars = spec.nominalScalars,+      mapped = spec.mapped,+      nodes =+        [ node+        | node@(NAggregate aggregate) <- spec.nodes,+          aggregate.name == aggregateName+        ]+    }++appendGuardTwins :: Name -> [Transition] -> Spec -> Spec+appendGuardTwins _ [] spec = spec+appendGuardTwins aggregateName twins spec =+  Spec+    { context = spec.context,+      moduleRoot = spec.moduleRoot,+      layout = spec.layout,+      ids = spec.ids,+      enums = spec.enums,+      rules = spec.rules,+      nominalScalars = spec.nominalScalars,+      mapped = spec.mapped,+      nodes =+        [ case node of+            NAggregate aggregate+              | aggregate.name == aggregateName ->+                  NAggregate (appendAggregateTransitions twins aggregate)+            _ -> node+        | node <- spec.nodes+        ]+    }++appendAggregateTransitions :: [Transition] -> Aggregate -> Aggregate+appendAggregateTransitions additions aggregate =+  Aggregate+    { name = aggregate.name,+      regs = aggregate.regs,+      states = aggregate.states,+      commands = aggregate.commands,+      events = aggregate.events,+      transitions = aggregate.transitions <> additions,+      domainOutcomeTypes = aggregate.domainOutcomeTypes,+      domainOutcomeDuplicateLocs = aggregate.domainOutcomeDuplicateLocs,+      wire = aggregate.wire,+      projection = aggregate.projection,+      snapshot = aggregate.snapshot,+      loc = aggregate.loc+    }+ replaceTransitionGuardAndMode :: Maybe Expr -> TransitionMode -> Transition -> Transition replaceTransitionGuardAndMode guard mode transition =   Transition@@ -1785,11 +2094,11 @@       guard,       writes = transition.writes,       emits = transition.emits,-      outcome = transition.outcome,-      outcomeDuplicateLocs = transition.outcomeDuplicateLocs,+      outcome = Nothing,+      outcomeDuplicateLocs = [],       goto = transition.goto,       mode,-      loc = transition.loc+      loc = noLoc     }  addedAggregateDiff :: Aggregate -> [Change]@@ -2064,26 +2373,32 @@  idDiff :: DiffEnv -> [Change] idDiff env =-  concatMap (uncurry (idPairDiff ((.old) env))) ((.matched) paired)+  concatMap (uncurry (idPairDiff ((.old) env) ((.new) 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)+idPairDiff :: Spec -> Spec -> IdDecl -> IdDecl -> [Change]+idPairDiff oldSpec newSpec oldId newId =+  ( if (.prefix) oldId /= (.prefix) newId+      then+        breaking ((.name) newId) "id-prefix" ((.name) newId) IdPrefixChanged prefixDetail+          : [nominalUseChange use IdPrefixChanged prefixDetail | use <- nominalBoundaryUses oldSpec newSpec ((.name) oldId)]+      else []+  )+    <> nominalBindingDeclDiff oldSpec newSpec "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)+         use <- nominalUses oldSpec newSpec ((.name) oldId),+         nominalUseIsEvent use        ]+  where+    prefixDetail = "prefix changed '" <> (.prefix) oldId <> "' -> '" <> (.prefix) newId <> "'; stored and newly minted ids no longer share an identity domain"  addedIdDiff :: IdDecl -> [Change] addedIdDiff declaration = [additive ((.name) declaration) "id-prefix" ((.name) declaration) DeclarationAdded "new id declaration"]@@ -2093,29 +2408,43 @@  enumDiff :: DiffEnv -> [Change] enumDiff env =-  concatMap (uncurry (enumPairDiff ((.old) env))) ((.matched) paired)+  concatMap (uncurry (enumPairDiff ((.old) env) ((.new) 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-       ]+enumPairDiff :: Spec -> Spec -> EnumDecl -> EnumDecl -> [Change]+enumPairDiff oldSpec newSpec oldEnum newEnum =+  concat+    [ breaking ((.name) newEnum) "enum-constructor" ctor EnumCtorRemoved detail+        : [nominalUseChange use EnumCtorRemoved detail | use <- nestedUses]+    | (ctor, wire) <- (.ctors) oldEnum,+      isNothing (lookup ctor ((.ctors) newEnum)),+      let detail = "constructor removed; stored wire value '" <> wire <> "' no longer decodes" <> enumUsageSuffix oldSpec ((.name) oldEnum)+    ]     ++ concat+      [ breaking ((.name) newEnum) "enum-constructor" ctor EnumWireSpellingChanged detail+          : [nominalUseChange use EnumWireSpellingChanged detail | use <- nestedUses]+      | (ctor, oldWire) <- (.ctors) oldEnum,+        Just newWire <- [lookup ctor ((.ctors) newEnum)],+        oldWire /= newWire,+        let detail = "wire spelling changed '" <> oldWire <> "' -> '" <> newWire <> "'; stored values using the old spelling no longer decode" <> enumUsageSuffix oldSpec ((.name) oldEnum)+      ]+    ++ concat       [ enumAdditionDiff oldSpec newEnum ctor wire+          <> [ nominalUseChange+                 use+                 EnumCtorAdded+                 ("new constructor with wire spelling '" <> wire <> "'; deploy consumers before producers emit the new arm")+             | use <- nestedUses+             ]       | (ctor, wire) <- (.ctors) newEnum,         isNothing (lookup ctor ((.ctors) oldEnum))       ]-      <> nominalBindingDeclDiff oldSpec "enum" ((.name) newEnum) ((.binding) oldEnum) ((.binding) newEnum)+      <> nominalBindingDeclDiff oldSpec newSpec "enum" ((.name) newEnum) ((.binding) oldEnum) ((.binding) newEnum)+  where+    nestedUses = nominalBoundaryUses oldSpec newSpec ((.name) oldEnum)  nominalScalarDiff :: DiffEnv -> [Change] nominalScalarDiff env =@@ -2125,32 +2454,39 @@   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-      ]+      ( if (.representation) oldDeclaration /= (.representation) newDeclaration+          then+            nominalDeclarationChange ((.name) newDeclaration) NominalRepresentationChanged representationDetail+              : [nominalUseChange use NominalRepresentationChanged representationDetail | use <- nominalBoundaryUses ((.old) env) ((.new) env) ((.name) oldDeclaration)]+          else []+      )         <> nominalBindingDeclDiff           ((.old) env)+          ((.new) env)           "scalar"           ((.name) newDeclaration)           (Just ((.binding) oldDeclaration))           (Just ((.binding) newDeclaration))+      where+        representationDetail =+          "nominal scalar representation changed '"+            <> (.representation) oldDeclaration+            <> "' -> '"+            <> (.representation) newDeclaration+            <> "'"  data NominalUse   = NominalCommandUse !Name !Name !Name   | NominalEventUse !Name !Name !Name   | NominalRegisterUse !Name !Name+  | NominalStructuralUse !Name !UsePath+  | NominalConsumerRootUse !UsePath+  deriving stock (Eq, Ord, Show) -nominalUses :: Spec -> Name -> [NominalUse]-nominalUses spec target = concatMap usesInAggregate [aggregate | NAggregate aggregate <- (.nodes) spec]+nominalUses :: Spec -> Spec -> Name -> [NominalUse]+nominalUses oldSpec newSpec target = nub (directUses <> graphUses oldSpec <> graphUses newSpec)   where+    directUses = concatMap usesInAggregate [aggregate | NAggregate aggregate <- (.nodes) oldSpec]     usesInAggregate aggregate =       [ NominalCommandUse ((.name) aggregate) ((.name) command) ((.name) field)       | command <- (.commands) aggregate,@@ -2177,8 +2513,40 @@       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 =+    graphUses spec = case resolveTypeGraph spec of+      Left _ -> []+      Right graph -> mapMaybe pathUse (nominalUsePaths graph target)+    pathUse path@UsePath {root, segments} = case segments of+      SegDecl declaration : _ -> Just (NominalStructuralUse declaration path)+      SegNominal {} : _ -> case root of+        RootWorkqueueField {} -> Just (NominalConsumerRootUse path)+        RootReadModelQueryInput {} -> Just (NominalConsumerRootUse path)+        RootReadModelQueryResult {} -> Just (NominalConsumerRootUse path)+        RootContractField {} -> Just (NominalConsumerRootUse path)+        RootCommandField {} -> Nothing+        RootEventField {} -> Nothing+        RootRegister {} -> Nothing+      _ -> Nothing++nominalBoundaryUses :: Spec -> Spec -> Name -> [NominalUse]+nominalBoundaryUses oldSpec newSpec name =+  [ use+  | use <- nominalUses oldSpec newSpec name,+    case use of+      NominalStructuralUse {} -> True+      NominalConsumerRootUse {} -> True+      _ -> False+  ]++nominalUseIsEvent :: NominalUse -> Bool+nominalUseIsEvent = \case+  NominalEventUse {} -> True+  NominalStructuralUse _ UsePath {root = RootEventField {}} -> True+  NominalConsumerRootUse UsePath {root = RootEventField {}} -> True+  _ -> False++nominalBindingDeclDiff :: Spec -> Spec -> Text -> Name -> Maybe NominalBindingDecl -> Maybe NominalBindingDecl -> [Change]+nominalBindingDeclDiff oldSpec newSpec 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@@ -2203,9 +2571,13 @@       )     nominalFinding code detail =       nominalDeclarationChange name code (category <> " " <> detail)-        : [nominalUseChange use code detail | use <- nominalUses oldSpec name, includeUse code use]+        : [nominalUseChange use code detail | use <- nominalUses oldSpec newSpec name, includeUse code use]+    includeUse NominalFixturesChanged NominalStructuralUse {} = True+    includeUse NominalFixturesChanged NominalConsumerRootUse {} = True     includeUse NominalFixturesChanged _ = False     includeUse NominalCanonicalTypeChanged NominalRegisterUse {} = True+    includeUse NominalCanonicalTypeChanged NominalStructuralUse {} = True+    includeUse NominalCanonicalTypeChanged NominalConsumerRootUse {} = True     includeUse NominalCanonicalTypeChanged _ = False     includeUse NominalInitialChanged NominalRegisterUse {} = True     includeUse NominalInitialChanged _ = False@@ -2230,13 +2602,34 @@ 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)+    (root, facet, subject, kind) = nominalUseContext use     context = ChangeContext root [subject] kind LabelAdvisory     vector = classifyCompatibility context code +nominalUseContext :: NominalUse -> (Name, Text, Text, ContextKind)+nominalUseContext = \case+  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)+  NominalStructuralUse declaration path ->+    let (root, facet, kind) = nominalPathContext path+     in (root, facet, renderUsePath path <> " via " <> declaration, kind)+  NominalConsumerRootUse UsePath {root = RootContractField contract event field} ->+    (contract, "nominal-contract", "contract " <> contract <> " event " <> event <> " ." <> field, ContextPublicContract)+  NominalConsumerRootUse path ->+    let (root, facet, kind) = nominalPathContext path+     in (root, facet, renderUsePath path, kind)++nominalPathContext :: UsePath -> (Name, Text, ContextKind)+nominalPathContext path = case (.root) path of+  RootCommandField aggregate _ _ -> (aggregate, "nominal-structural-command", ContextConsumerBuild)+  RootEventField aggregate _ _ -> (aggregate, "nominal-structural-event", ContextPrivateEvent)+  RootRegister aggregate _ -> (aggregate, "nominal-structural-register", ContextSnapshot)+  RootWorkqueueField workqueue _ -> (workqueue, "nominal-workqueue", ContextQueue)+  RootReadModelQueryInput readModel -> (readModel, "nominal-query-input", ContextConsumerBuild)+  RootReadModelQueryResult readModel -> (readModel, "nominal-query-result", ContextConsumerBuild)+  RootContractField contract _ _ -> (contract, "nominal-contract", ContextPublicContract)+ addedEnumDiff :: EnumDecl -> [Change] addedEnumDiff enumDecl =   [additive ((.name) enumDecl) "enum-constructor" ctor EnumCtorAdded ("new enum constructor with wire spelling '" <> wire <> "'") | (ctor, wire) <- (.ctors) enumDecl]@@ -2309,14 +2702,14 @@  contractDiff :: DiffEnv -> [Change] contractDiff env =-  concatMap (uncurry contractPairDiff) ((.matched) paired)+  concatMap (uncurry (contractPairDiff env)) ((.matched) paired)     ++ concatMap addedContractDiff ((.added) paired)     ++ concatMap removedContractDiff ((.removed) paired)   where     paired = pairByName nodeContract (.name) env -contractPairDiff :: ContractNode -> ContractNode -> [Change]-contractPairDiff oldContract newContract =+contractPairDiff :: DiffEnv -> ContractNode -> ContractNode -> [Change]+contractPairDiff env oldContract newContract =   schemaChanges     ++ discriminatorChanges     ++ topicChanges@@ -2347,7 +2740,7 @@     matchedEvents = (.matched) eventPairs     addedEvents = (.added) eventPairs     removedEvents' = (.removed) eventPairs-    eventPairChanges (oldEvent, newEvent) = contractEventDiff oldContract newContract oldEvent newEvent+    eventPairChanges (oldEvent, newEvent) = contractEventDiff env oldContract newContract oldEvent newEvent     addedEventChanges event =       [additive ((.name) newContract) "contract-event" ((.name) event) ContractEventAdded "new contract event"]     removedEventChanges event =@@ -2387,8 +2780,8 @@          isNothing (lookup alias ((.topics) oldContract))        ] -contractEventDiff :: ContractNode -> ContractNode -> ContractEvent -> ContractEvent -> [Change]-contractEventDiff oldContract newContract oldEvent newEvent =+contractEventDiff :: DiffEnv -> ContractNode -> ContractNode -> ContractEvent -> ContractEvent -> [Change]+contractEventDiff env oldContract newContract oldEvent newEvent =   topicAliasChange     ++ removedFieldChanges     ++ changedFieldChanges@@ -2411,15 +2804,29 @@       | field <- (.removed) fieldPairs       ]     changedFieldChanges =-      [ breaking-          ((.name) newContract)-          "contract-field"-          ((.name) newEvent <> "." <> (.name) newField)-          ContractFieldChanged-          ("field type changed " <> renderContractType ((.valueType) oldField) <> " -> " <> renderContractType ((.valueType) newField))+      [ fieldTypeChange oldField newField       | (oldField, newField) <- (.matched) fieldPairs,         (.valueType) oldField /= (.valueType) newField       ]+    fieldTypeChange oldField newField+      | literalDeclaredSamePrefix =+          advisoryAt+            (consumerBuildContext ((.name) newContract) [subject])+            ((.name) newContract)+            "contract-field"+            subject+            ContractFieldChanged+            (detail <> "; canonical JSON bytes and TypeID admission are unchanged, but generated consumers must rebuild for the declared Haskell type")+      | otherwise = breaking ((.name) newContract) "contract-field" subject ContractFieldChanged detail+      where+        subject = (.name) newEvent <> "." <> (.name) newField+        detail = "field type changed " <> renderContractType ((.valueType) oldField) <> " -> " <> renderContractType ((.valueType) newField)+        literalDeclaredSamePrefix =+          isLiteralDeclaredTransition ((.valueType) oldField) ((.valueType) newField)+            && contractTypePrefix ((.old) env) ((.valueType) oldField) == contractTypePrefix ((.new) env) ((.valueType) newField)+    isLiteralDeclaredTransition CTypeId {} CDeclaredId {} = True+    isLiteralDeclaredTransition CDeclaredId {} CTypeId {} = True+    isLiteralDeclaredTransition _ _ = False     selectorFieldChanges =       [ fieldSelectorChange           ((.name) newContract)@@ -2458,9 +2865,15 @@  renderContractType :: ContractType -> Text renderContractType (CTypeId prefix) = "typeid '" <> prefix <> "'"+renderContractType (CDeclaredId name) = name renderContractType CText = "text" renderContractType CInt = "int" +contractTypePrefix :: Spec -> ContractType -> Maybe Text+contractTypePrefix _ (CTypeId prefix) = Just prefix+contractTypePrefix spec (CDeclaredId name) = (.prefix) <$> find ((== name) . (.name)) ((.ids) spec)+contractTypePrefix _ _ = Nothing+ workqueueDiff :: DiffEnv -> [Change] workqueueDiff env =   concatMap (uncurry workqueuePairDiff) ((.matched) paired)@@ -2639,6 +3052,7 @@ renderWqOrdering WqUnordered = "unordered" renderWqOrdering WqFifoThroughput = "fifo-throughput" renderWqOrdering WqFifoRoundRobin = "fifo-roundrobin"+renderWqOrdering WqFifoHeads = "fifo-heads"  renderWqProvision :: WqProvision -> Text renderWqProvision WqStandard = "standard"@@ -2662,7 +3076,115 @@     paired = pairByName nodeProcess (.id) env  processPairDiff :: ProcessNode -> ProcessNode -> [Change]-processPairDiff oldProcess newProcess =+processPairDiff oldProcess newProcess = case ((.body) oldProcess, (.body) newProcess) of+  (LegacyProcessBody {}, LegacyProcessBody {}) -> legacyProcessPairDiff oldProcess newProcess+  (ReactionProcessBody oldReaction, ReactionProcessBody newReaction) -> reactionProcessPairDiff oldProcess oldReaction newProcess newReaction+  _ ->+    [ breaking+        ((.id) newProcess)+        "dispatch-identity-model"+        ((.id) newProcess)+        ProcessDispatchIdentityModelChanged+        "process changed between legacy positional dispatch identity and reaction target-keyed identity; drain or pause the process subscription before deploying and follow docs/user/deploy-ordering.md"+    ]++reactionProcessPairDiff :: ProcessNode -> ReactionBody -> ProcessNode -> ReactionBody -> [Change]+reactionProcessPairDiff oldProcess oldReaction newProcess newReaction =+  reactionIdentityDiff+    ++ concatMap (uncurry (reactionNodeDiff processName)) ((.matched) reactions)+    ++ map reactionAdded ((.added) reactions)+    ++ map reactionRemoved ((.removed) reactions)+    ++ concatMap (uncurry (reactionTimerDiff processName)) ((.matched) timers)+    ++ map timerAdded ((.added) timers)+    ++ map timerRemoved ((.removed) timers)+    ++ timerCeilingDiff+    ++ reactionVersionDiff+  where+    processName = (.id) newProcess+    reactions = pairDeclarations (.on) (NE.toList ((.reactions) oldReaction)) (NE.toList ((.reactions) newReaction))+    timers = pairDeclarations (.name) ((.timers) oldReaction) ((.timers) newReaction)+    reactionIdentityDiff =+      [ breaking processName "derived-identity" processName DerivedIdentityChanged "process name, correlation derivation, saga stream category, or target aggregate changed; replays and retries no longer derive the persisted reaction identity"+      | reactionProcessIdentity oldProcess /= reactionProcessIdentity newProcess+      ]+    reactionAdded reaction =+      additive processName "process-reaction" ((.on) reaction) ProcessReactionAdded "input variant gained a declarative reaction"+    reactionRemoved reaction =+      advisory processName "process-reaction" ((.on) reaction) ProcessReactionRemoved "input variant reaction was removed; drain or pause the process subscription before deploying so an old binary cannot acknowledge work the new graph no longer handles"+    timerAdded timer =+      additive processName "process-timer" ((.name) timer) ProcessTimerAdded "timer declaration added"+    timerRemoved timer =+      breaking processName "process-timer" ((.name) timer) ProcessTimerRemoved "timer declaration removed while scheduled rows may still fire; drain or migrate outstanding timer rows before deploying"+    timerCeilingDiff =+      [ advisory processName "process-timer-policy" processName ProcessTimerCeilingChanged ("timer operator policy changed (max-attempts " <> tInt oldCeiling <> " -> " <> tInt newCeiling <> "); already-attempted rows keep their persisted attempt count")+      | Just oldPolicy <- [(.timerPolicy) oldReaction],+        Just newPolicy <- [(.timerPolicy) newReaction],+        let oldCeiling = (.maxAttempts) oldPolicy,+        let newCeiling = (.maxAttempts) newPolicy,+        oldPolicy /= newPolicy+      ]+    oldVersion = (.version) oldReaction+    newVersion = (.version) newReaction+    oldFingerprint = processReactionFingerprintFrom oldReaction+    newFingerprint = processReactionFingerprintFrom newReaction+    reactionVersionDiff+      | newVersion < oldVersion =+          [breaking processName "process-reaction-version" processName ProcessReactionVersionDecreased ("reaction version decreased from " <> T.pack (show oldVersion) <> " to " <> T.pack (show newVersion))]+      | oldFingerprint /= newFingerprint && newVersion == oldVersion =+          [breaking processName "process-reaction-fingerprint" processName ProcessReactionFingerprintChangedWithoutVersionBump "reaction semantics changed without increasing reactions version; bump the version and coordinate the drain/redeploy"]+      | oldFingerprint /= newFingerprint && newVersion > oldVersion =+          [advisory processName "process-reaction-fingerprint" processName ProcessReactionFingerprintChangedWithVersionBump ("reaction semantics changed with version " <> T.pack (show oldVersion) <> " -> " <> T.pack (show newVersion) <> "; coordinate drain and redelivery around the new fingerprint")]+      | otherwise = []++reactionProcessIdentity :: ProcessNode -> (Text, Name, Name, Text, Name)+reactionProcessIdentity process =+  ( (.name) process,+    (.field) ((.correlate) process),+    (.via) ((.correlate) process),+    (.category) ((.saga) process),+    (.target) process+  )++reactionNodeDiff :: Name -> ReactionNode -> ReactionNode -> [Change]+reactionNodeDiff processName oldReaction newReaction+  | reordered =+      [ advisory processName "process-reaction-arms" inputName ProcessReactionArmsReordered "reaction arms were reordered; ordinal dispatch occurrences and the chosen guarded branch changed"+      ]+  | otherwise = concat (zipWith armDiff [1 :: Int ..] pairedArms) ++ countDiff+  where+    inputName = (.on) newReaction+    oldArms = NE.toList ((.arms) oldReaction)+    newArms = NE.toList ((.arms) newReaction)+    oldRendered = map renderReactionArmSurface oldArms+    newRendered = map renderReactionArmSurface newArms+    reordered = oldRendered /= newRendered && sort oldRendered == sort newRendered+    pairedArms = zip oldArms newArms+    armDiff ordinal (oldArm, newArm) =+      [ advisory processName "process-reaction-guard" (inputName <> "#" <> tInt ordinal) ProcessReactionGuardChanged "reaction guard changed at this arm ordinal; a redelivered source may select a different branch"+      | renderReactionArmGuardSurface oldArm /= renderReactionArmGuardSurface newArm+      ]+        ++ [ advisory processName "process-reaction-fan-out" (inputName <> "#" <> tInt ordinal) ProcessReactionFanOutChanged "reaction follow-ups changed at this arm ordinal; drain before deploy so redelivery cannot merge old and new target-keyed fan-out"+           | renderReactionArmBodySurface oldArm /= renderReactionArmBodySurface newArm+           ]+    countDiff =+      [ advisory processName "process-reaction-fan-out" inputName ProcessReactionFanOutChanged "reaction arm count changed; the guarded fan-out surface no longer has the same ordinals"+      | length oldArms /= length newArms+      ]++reactionTimerDiff :: Name -> ReactionTimerNode -> ReactionTimerNode -> [Change]+reactionTimerDiff processName oldTimer newTimer =+  [ breaking processName "process-timer-identity" timerName ProcessTimerIdentityChanged "timer id or fired-event id prefix changed; scheduled rows and deterministic fire identities no longer address the same timer"+  | timerPrefixes oldTimer /= timerPrefixes newTimer+  ]+    ++ [ advisory processName "timer-payload" timerName ProcessTimerPayloadChanged "timer payload shape changed: rows scheduled before the deploy carry the old shape and the fire decoder must accept every historically scheduled payload"+       | renderReactionTimerPayloadSurface oldTimer /= renderReactionTimerPayloadSurface newTimer+       ]+  where+    timerName = (.name) newTimer+    timerPrefixes timer = ((.prefix) ((.id) timer), (.prefix) ((.firedEventId) ((.fire) timer)))++legacyProcessPairDiff :: ProcessNode -> ProcessNode -> [Change]+legacyProcessPairDiff 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)@@ -2672,7 +3194,7 @@     ++ 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))+    fields = pairDeclarations (.name) ((.fields) (legacyProcessInput oldProcess)) ((.fields) (legacyProcessInput newProcess))     pairedFieldDiff (oldField, newField)       | (.valueType) oldField /= (.valueType) newField = [fieldChange ("type changed " <> renderFieldType ((.valueType) oldField) <> " -> " <> renderFieldType ((.valueType) newField)) newField]       | otherwise = []@@ -2680,11 +3202,11 @@  addedProcessDiff :: ProcessNode -> [Change] addedProcessDiff process =-  [additive ((.id) process) "input-field" ((.name) field) DeclarationAdded "field belongs to a new process input" | field <- (.fields) ((.input) process)]+  [additive ((.id) process) "input-field" ((.name) field) DeclarationAdded "field belongs to a new process input" | input <- processInputs process, field <- (.fields) input]  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) "input-field" ((.name) field) ProcessInputChanged "process removed while persisted source events may still require this input decoder" | input <- processInputs process, field <- (.fields) input]     ++ [breaking ((.id) process) "derived-identity" ((.id) process) DerivedIdentityChanged "process removed while persisted saga, dispatch, and timer identities may still exist"]  processIdentityDiff :: ProcessNode -> ProcessNode -> [Change]@@ -2704,10 +3226,10 @@     (.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)))+    (.prefix) ((.id) (legacyProcessTimer process)),+    (.field) ((.id) (legacyProcessTimer process)),+    (.prefix) ((.firedEventId) ((.fire) (legacyProcessTimer process))),+    (.field) ((.firedEventId) ((.fire) (legacyProcessTimer process)))   )  processTimerWindowDiff :: ProcessNode -> ProcessNode -> [Change]@@ -2715,15 +3237,15 @@   [ advisory       ((.id) newProcess)       "timer"-      ((.name) ((.timer) newProcess))+      ((.name) (legacyProcessTimer newProcess))       TimerWindowChanged       ( "fireAt source/window changed "-          <> renderFireAt ((.fireAt) ((.timer) oldProcess))+          <> renderFireAt ((.fireAt) (legacyProcessTimer oldProcess))           <> " -> "-          <> renderFireAt ((.fireAt) ((.timer) newProcess))+          <> renderFireAt ((.fireAt) (legacyProcessTimer newProcess))           <> "; already-scheduled timers keep their persisted deadline"       )-  | (.fireAt) ((.timer) oldProcess) /= (.fireAt) ((.timer) newProcess)+  | (.fireAt) (legacyProcessTimer oldProcess) /= (.fireAt) (legacyProcessTimer newProcess)   ]  processDecideSurfaceDiff :: ProcessNode -> ProcessNode -> [Change]@@ -2734,8 +3256,8 @@       ((.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)+  | renderHandleSurface (legacyProcessHandle oldProcess)+      /= renderHandleSurface (legacyProcessHandle newProcess)   ]  processTimerPayloadDiff :: ProcessNode -> ProcessNode -> [Change]@@ -2743,13 +3265,33 @@   [ advisory       ((.id) newProcess)       "timer-payload"-      ((.name) ((.timer) newProcess))+      ((.name) (legacyProcessTimer 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)+  | renderTimerPayloadSurface (legacyProcessTimer oldProcess)+      /= renderTimerPayloadSurface (legacyProcessTimer newProcess)   ] +processInputs :: ProcessNode -> [InputDecl]+processInputs process = case (.body) process of+  LegacyProcessBody input _ _ -> [input]+  ReactionProcessBody reaction -> NE.toList ((.inputs) reaction)++legacyProcessInput :: ProcessNode -> InputDecl+legacyProcessInput process = case (.body) process of+  LegacyProcessBody input _ _ -> input+  ReactionProcessBody {} -> error "keiro-dsl internal invariant: reaction process used as legacy input"++legacyProcessHandle :: ProcessNode -> HandleNode+legacyProcessHandle process = case (.body) process of+  LegacyProcessBody _ handle _ -> handle+  ReactionProcessBody {} -> error "keiro-dsl internal invariant: reaction process used as legacy handle"++legacyProcessTimer :: ProcessNode -> TimerNode+legacyProcessTimer process = case (.body) process of+  LegacyProcessBody _ _ timer -> timer+  ReactionProcessBody {} -> error "keiro-dsl internal invariant: reaction process used as legacy timer"+ renderFireAt :: FireAtExpr -> Text renderFireAt expression = "input." <> (.field) expression <> " + " <> (.window) expression @@ -2825,6 +3367,19 @@       "dedupe key or policy changed; redelivered messages no longer match their persisted dedupe record"   | ((.dedupeKey) oldIntake, (.dedupePolicy) oldIntake) /= ((.dedupeKey) newIntake, (.dedupePolicy) newIntake)   ]+    ++ [ breaking+           ((.name) newIntake)+           "inbox-idempotence-mode"+           ((.name) newIntake)+           IntakeIdempotenceModeChanged+           ( "intake idempotence ownership changed "+               <> renderIdempotenceMode ((.idempotence) oldIntake)+               <> " -> "+               <> renderIdempotenceMode ((.idempotence) newIntake)+               <> "; persisted dedupe history does not transfer between the inbox table and the downstream state machine"+           )+       | (.idempotence) oldIntake /= (.idempotence) newIntake+       ]     ++ [ advisory            ((.name) newIntake)            "decode-posture"@@ -2846,6 +3401,10 @@ renderInkPersist InkPersistFull = "full-envelope" renderInkPersist InkPersistDedupeOnly = "dedupe-only" +renderIdempotenceMode :: IdempotenceMode -> Text+renderIdempotenceMode IdemInboxTable = "table"+renderIdempotenceMode IdemDelegated = "delegated"+ addedIntakeDiff :: IntakeNode -> [Change] addedIntakeDiff intake = [additive ((.name) intake) "intake" ((.name) intake) DeclarationAdded "new intake"] @@ -3130,6 +3689,11 @@       [ DerivedIdentityChanged,         IdPrefixChanged,         DedupeIdentityChanged,+        ProcessDispatchIdentityModelChanged,+        ProcessTimerIdentityChanged,+        ProcessTimerRemoved,+        ProcessReactionVersionDecreased,+        ProcessReactionFingerprintChangedWithoutVersionBump,         RouterStableNameChanged,         WorkflowStableNameChanged,         ReadModelVersionDecreased,@@ -3157,6 +3721,8 @@         WorkflowPatchRemoved,         WorkflowContinueSeedChanged,         AggGuardTightened,+        AggGuardRelationUnknown,+        AggGuardRemedyUnavailable,         DeprecatedEventReplayHazard,         EventRetirementInProgress,         EventUndeprecated,
src/Keiro/Dsl/DiffReport.hs view
@@ -279,6 +279,10 @@   | code == OwnershipMoved = RemedyRescaffoldWorkspace :| []   | code == WorkspaceAuthorityChanged = RemedyRescaffoldWorkspace :| [RemedyRecompileConsumers]   | code == AggGuardTightened = RemedyReplayOnlyEdge :| [RemedyRunConformance]+  | code == AggGuardRelationUnknown =+      RemedyDoNotDeploy "do not deploy until the transition-family ambiguity is resolved or a targeted replay audit proves the affected history safe" :| []+  | code == AggGuardRemedyUnavailable =+      RemedyDoNotDeploy "do not deploy until the replay-only remedy validates under the candidate language or a targeted replay audit proves the affected history safe" :| []   | code == AggFoldSurfaceChanged = RemedyStateCodecBump :| [RemedyRunConformance]   | code == IdDomainContractChanged =       RemedyDeploymentOrder RolloutProducerLast :| [RemedyStateCodecBump, RemedyRecompileConsumers, RemedyRunConformance]@@ -397,6 +401,9 @@       [ DerivedIdentityChanged,         IdPrefixChanged,         DedupeIdentityChanged,+        IntakeIdempotenceModeChanged,+        ProcessDispatchIdentityModelChanged,+        ProcessTimerIdentityChanged,         RouterStableNameChanged,         WorkflowStableNameChanged,         ReadModelVersionDecreased,
src/Keiro/Dsl/ExplainBindings.hs view
@@ -21,6 +21,7 @@ import Data.List (groupBy, sortOn) import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict qualified as Map+import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T import Keiro.Dsl.Grammar@@ -147,7 +148,7 @@       [ obligationsFor graph declaration       | ResolvedStructural declaration _ <- Map.elems ((.declarations) graph)       ]-      <> concatMap (nominalObligationsFor service) (Map.elems (nominalTypes nominalRegistry))+      <> concatMap (nominalObligationsFor service graph) (Map.elems (nominalTypes nominalRegistry))   where     spec = checkedSpec service @@ -234,7 +235,9 @@         onOptional = \value -> "Maybe (" <> value <> ")",         onList = \value -> "[" <> value <> "]",         onMap = \value -> "Map Text (" <> value <> ")",-        onRef = unMappedKey+        onKeyedMap = \key value -> "Map " <> (.name) key <> " (" <> value <> ")",+        onRef = unMappedKey,+        onNominal = (.name)       }  obligationsFor :: TypeGraph -> StructuralDecl -> [BindingObligation]@@ -292,15 +295,17 @@   where     (ownerModule, symbol) = splitQualified (unQualifiedValueName qualified) -nominalObligationsFor :: CheckedService -> ResolvedNominalType -> [BindingObligation]-nominalObligationsFor service nominal = case (.ownership) nominal of+nominalObligationsFor :: CheckedService -> TypeGraph -> ResolvedNominalType -> [BindingObligation]+nominalObligationsFor service graph nominal = case (.ownership) nominal of   GeneratedNominal -> []   ConsumerNominal binding -> bindingEntry : fixtureEntry : initialEntries     where       name = (.name) nominal       source = (.haskell) binding       consumerType = (.moduleName) source <> "." <> (.valueType) source-      paths = useSites spec name+      paths =+        Set.toAscList . Set.fromList $+          useSites spec name <> map renderUsePath (nominalUsePaths graph name)       registerPaths = [path | path <- paths, " register " `T.isInfixOf` path]       category = case (.representation) nominal of         IdRepresentation {} -> "nominal-id"@@ -411,6 +416,10 @@         <> 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)+        <> [ "      ordering-contract: Ord " <> (.mappedName) obligation <> " must agree with canonical TypeID text order"+           | (.category) obligation == "nominal-id",+             any (" {key}" `T.isInfixOf`) ((.useSites) obligation)+           ]     renderPaths [] = " (not currently used by an aggregate root)"     renderPaths paths = " (" <> T.intercalate "; " paths <> ")"     quoted value = T.pack (show value)
src/Keiro/Dsl/Expression.hs view
@@ -87,7 +87,8 @@ data ResolvedScalarProjection = ResolvedScalarProjection   { owner :: !MappedKey,     pointer :: !Text,-    fields :: ![Name]+    fields :: ![Name],+    terminalNominal :: !(Maybe NominalLeaf)   }   deriving stock (Eq, Show) @@ -136,7 +137,9 @@   | ScalarLiteralNeedsType   | ScalarLiteralInvalid   | ScalarOperandTypeMismatch+  | ScalarNominalTypeMismatch   | ScalarOperatorUnsupported+  | ScalarNominalOperatorUnsupported   | ScalarBooleanOperandRequired   | ScalarGuardBoolRequired   | ScalarWriteTargetUnknown@@ -238,7 +241,7 @@       | otherwise =           failure             ((.loc) right)-            ScalarOperandTypeMismatch+            (nominalMismatchCode ((.valueType) left) ((.valueType) right))             ( "expression operands have different scalar types '"                 <> aggregateCanonicalName ((.valueType) left)                 <> "' and '"@@ -262,7 +265,7 @@         unsupported useSite =           failure             ((.loc) operand)-            ScalarOperatorUnsupported+            (case (.valueType) operand of AggregateNominal {} -> ScalarNominalOperatorUnsupported; _ -> ScalarOperatorUnsupported)             ( renderUseSite useSite                 <> " is unsupported for scalar type '"                 <> aggregateCanonicalName ((.valueType) operand)@@ -280,7 +283,7 @@       | otherwise =           failure             ((.loc) resolved)-            ScalarOperandTypeMismatch+            (nominalMismatchCode wanted ((.valueType) resolved))             ( "expected scalar type '"                 <> aggregateCanonicalName wanted                 <> "', found '"@@ -326,7 +329,7 @@           | otherwise -> Right resolved         where           writeDiagnostic diagnostic-            | (.code) diagnostic == ScalarOperandTypeMismatch =+            | (.code) diagnostic `elem` [ScalarOperandTypeMismatch, ScalarNominalTypeMismatch] =                 replaceExpressionDiagnostic                   ScalarWriteTypeMismatch                   ( "write to register '"@@ -405,7 +408,7 @@         ScalarPathInvalid         ("cannot project fields through scalar type '" <> aggregateCanonicalName other <> "'")   graph <- maybe (failure loc ScalarPathUnsupported "mapped structural graph is unavailable") Right ((.typeGraph) environment)-  (resolvedType, wireKeys) <- walk graph owner fields+  (resolvedType, terminalNominal, wireKeys) <- walk graph owner fields   if scalarLeaf resolvedType     then       pure@@ -418,7 +421,8 @@                 ResolvedScalarProjection                   { owner = owner,                     pointer = T.concat ["/" <> escapePointer key | key <- wireKeys],-                    fields = fields+                    fields = fields,+                    terminalNominal = terminalNominal                   }           }     else@@ -438,24 +442,30 @@       Nothing -> failure loc ScalarPathInvalid ("required structural field '" <> name <> "' does not exist")       Just field         | (.presence) field /= PRequired -> failure loc ScalarPathUnsupported ("field '" <> name <> "' is optional; scalar paths must be total")-        | null rest -> (,[(.key) field]) <$> resolvedLeaf ((.valueType) field)+        | null rest -> do+            (leafType, nominal) <- resolvedLeaf ((.valueType) field)+            pure (leafType, nominal, [(.key) field])         | RRef nextOwner <- (.valueType) field -> do-            (leafType, keys) <- walk graph nextOwner rest-            pure (leafType, (.key) field : keys)+            (leafType, nominal, keys) <- walk graph nextOwner rest+            pure (leafType, nominal, (.key) field : keys)         | otherwise -> failure loc ScalarPathUnsupported ("field '" <> name <> "' is not a required structural record")      resolvedLeaf = \case-      RText -> Right AggregateText-      RInt -> Right AggregateInt-      RInteger -> Right AggregateInteger-      RBool -> Right AggregateBool-      RNatural -> Right AggregateNatural-      RTime -> Right AggregateTime+      RText -> Right (AggregateText, Nothing)+      RInt -> Right (AggregateInt, Nothing)+      RInteger -> Right (AggregateInteger, Nothing)+      RBool -> Right (AggregateBool, Nothing)+      RNatural -> Right (AggregateNatural, Nothing)+      RTime -> Right (AggregateTime, Nothing)       RJson -> unsupported "Json"       ROptional {} -> unsupported "Optional"       RList {} -> unsupported "List"       RMap {} -> unsupported "Map"-      RRef key -> Right (AggregateMapped key)+      RKeyedMap {} -> unsupported "Map"+      RRef key -> Right (AggregateMapped key, Nothing)+      RNominal leaf -> case lookupAggregateNominal ((.name) leaf) ((.symbols) environment) of+        Just nominal -> Right (AggregateNominal nominal, Just leaf)+        Nothing -> failure loc ScalarPathInvalid ("nominal leaf '" <> (.name) leaf <> "' has no checked aggregate nominal declaration")     unsupported name = failure loc ScalarPathUnsupported (name <> " is not a supported scalar path leaf")  resolveLiteral :: ExpressionEnvironment -> Loc -> ExpectedScalarType -> ScalarLiteral -> Either (NonEmpty ExpressionDiagnostic) TypedScalarExpr@@ -486,7 +496,7 @@     mismatch other syntax =       failure         loc-        ScalarOperandTypeMismatch+        (case other of AggregateNominal {} -> ScalarNominalTypeMismatch; _ -> ScalarOperandTypeMismatch)         (syntax <> " literal cannot inhabit scalar type '" <> aggregateCanonicalName other <> "'")  resolveEnumLiteral :: ExpressionEnvironment -> Loc -> ExpectedScalarType -> Name -> Name -> Either (NonEmpty ExpressionDiagnostic) TypedScalarExpr@@ -507,7 +517,7 @@       InferScalarType -> Right ()       ExpectScalarType wanted         | wanted == resolved -> Right ()-        | otherwise -> failure loc ScalarOperandTypeMismatch ("enum literal has type '" <> aggregateCanonicalName resolved <> "', expected '" <> aggregateCanonicalName wanted <> "'")+        | otherwise -> failure loc (nominalMismatchCode resolved wanted) ("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) . (.name)) ((.ids) ((.spec) environment)) of@@ -525,8 +535,14 @@             InferScalarType -> pure ()             ExpectScalarType wanted               | wanted == resolved -> pure ()-              | otherwise -> failure loc ScalarOperandTypeMismatch ("ID literal has type '" <> aggregateCanonicalName resolved <> "', expected '" <> aggregateCanonicalName wanted <> "'")+              | otherwise -> failure loc (nominalMismatchCode resolved wanted) ("ID literal has type '" <> aggregateCanonicalName resolved <> "', expected '" <> aggregateCanonicalName wanted <> "'")           pure (literalExpr loc resolved (ScalarIdValue typeName value))++nominalMismatchCode :: ResolvedAggregateType -> ResolvedAggregateType -> ExpressionDiagnosticCode+nominalMismatchCode left right = case (left, right) of+  (AggregateNominal {}, _) -> ScalarNominalTypeMismatch+  (_, AggregateNominal {}) -> ScalarNominalTypeMismatch+  _ -> ScalarOperandTypeMismatch  arithmeticEvidence :: Loc -> ResolvedAggregateType -> Either (NonEmpty ExpressionDiagnostic) ArithmeticEvidence arithmeticEvidence _ AggregateInteger = Right ExactIntegerArithmetic
src/Keiro/Dsl/FoldFingerprint.hs view
@@ -83,6 +83,7 @@             ++ registerSegments             ++ mappedRegisterSegments graph             ++ nominalSegments nominalRegistry+            ++ nestedNominalSegments graph             ++ ["nominal-equality-use:" <> identity | identity <- Set.toAscList equalityUses]             ++ transitionSegments             ++ map ruleSegment referencedRules@@ -107,6 +108,61 @@         Just nominal <- [lookupNominalType typeName registry],         ConsumerNominal binding <- [(.ownership) nominal]       ]+    nestedNominalSegments graph =+      [ nestedNominalUseSegment path leaf+      | leaf <- Map.elems ((.nominalLeaves) graph),+        path <- nominalUsePaths graph ((.name) leaf),+        isNestedAggregateFoldUse ((.name) aggregate) path+      ]++-- | Nested nominal leaves participate in an aggregate fold wherever persisted+-- event payloads or snapshot registers contain their enclosing structural+-- declaration.  The structural register's own initial binding constructs the+-- whole value, so a nested nominal's @initial@ symbol is deliberately absent.+isNestedAggregateFoldUse :: Name -> UsePath -> Bool+isNestedAggregateFoldUse aggregateName UsePath {root, segments} =+  isNested segments && case root of+    RootEventField owner _ _ -> owner == aggregateName+    RootRegister owner _ -> owner == aggregateName+    RootCommandField {} -> False+    RootWorkqueueField {} -> False+    RootReadModelQueryInput {} -> False+    RootReadModelQueryResult {} -> False+    RootContractField {} -> False+  where+    isNested (SegDecl {} : _) = True+    isNested _ = False++nestedNominalUseSegment :: UsePath -> NominalLeaf -> Text+nestedNominalUseSegment path leaf =+  T.intercalate+    "|"+    ( [ "nested-nominal-use:" <> renderUsePath path,+        "name=" <> (.name) leaf,+        "representation=" <> nominalLeafRepresentationSegment ((.kind) leaf)+      ]+        <> ownershipSegments ((.ownership) leaf)+    )+  where+    ownershipSegments GeneratedLeaf = ["owner=generated"]+    ownershipSegments (ConsumerLeaf binding) =+      [ "owner=consumer",+        "canonical=" <> unCanonicalTypeId ((.canonical) binding),+        "binding=" <> unQualifiedValueName ((.binding) binding),+        "binding-version=" <> unBindingVersion ((.bindingVersion) binding)+      ]++nominalLeafRepresentationSegment :: NominalLeafKind -> Text+nominalLeafRepresentationSegment = \case+  NominalIdLeaf prefix -> "id:" <> prefix+  NominalEnumLeaf constructors ->+    "enum:" <> T.intercalate "," [constructor <> "=" <> wire | (constructor, wire) <- NE.toList constructors]+  NominalScalarLeaf representation -> case representation of+    NominalText -> "Text"+    NominalInt -> "Int"+    NominalNatural -> "Natural"+    NominalBool -> "Bool"+    NominalTime -> "Time"  -- | Equality representation belongs in the fold identity only when a guard -- actually compares that declaration. This keeps unrelated binding metadata out
src/Keiro/Dsl/Frontend/Internal.hs view
@@ -216,6 +216,8 @@         [(AggregateStateSubject aggregateName stateName, sourceSpan)]       SurfaceAggregateTransition aggregateName ordinal ->         [(AggregateTransitionSubject aggregateName (TransitionOrdinal ordinal), sourceSpan)]+      SurfaceProcessReaction processName inputName ordinal ->+        [(ProcessReactionSubject processName inputName ordinal, sourceSpan)]       SurfaceField {} -> []       SurfaceExpression {} -> [] @@ -279,14 +281,13 @@ setNodeLoc loc = \case   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)+  NProcess process -> NProcess process {loc = 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)+  NIntake (IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition _) ->+    NIntake (IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence 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 _) ->
src/Keiro/Dsl/Goldens.hs view
@@ -247,8 +247,25 @@         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 ((.declarations) graph))+        onKeyedMap = \key value -> Object (KeyMap.singleton (Key.fromText (sampleNominalKey key)) value),+        onRef = \key -> maybe emptyObject (sampleMappedDeclaration graph) (Map.lookup key ((.declarations) graph)),+        onNominal = sampleNominalLeaf       }++sampleNominalLeaf :: NominalLeaf -> Value+sampleNominalLeaf leaf = case (.kind) leaf of+  NominalIdLeaf prefix -> String (prefix <> "_01h455vb4pex5vsknk084sn02q")+  NominalEnumLeaf constructors -> String (snd (NE.head constructors))+  NominalScalarLeaf NominalText -> String "sample"+  NominalScalarLeaf NominalInt -> Number 1+  NominalScalarLeaf NominalNatural -> Number 1+  NominalScalarLeaf NominalBool -> Bool True+  NominalScalarLeaf NominalTime -> String "2026-01-01T00:00:00Z"++sampleNominalKey :: NominalLeaf -> Text+sampleNominalKey leaf = case sampleNominalLeaf leaf of+  String value -> value+  _ -> error "keiro-dsl internal invariant: keyed map key is not text"  emptyObject :: Value emptyObject = Object KeyMap.empty
src/Keiro/Dsl/Grammar.hs view
@@ -83,6 +83,19 @@     FireDisposition (..),     FireNode (..),     TimerNode (..),+    ProcessBody (..),+    ReactionBody (..),+    ReactionNode (..),+    ReactionArm (..),+    ArmGuard (..),+    ArmBody (..),+    AdvanceReaction (..),+    FollowUp (..),+    ScheduleNode (..),+    ScheduleMode (..),+    TimerPolicy (..),+    ReactionTimerNode (..),+    PayloadField (..),     PolicyChoice (..),     ProcessNode (..), @@ -107,6 +120,7 @@     DispositionRow (..),     DecodeSpec (..),     InkPersist (..),+    IdempotenceMode (..),     IntakeNode (..),      -- * The integration emit/publisher nodes (EP-4)@@ -171,6 +185,7 @@   ) where +import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic)@@ -246,6 +261,7 @@   | TOptional !TypeExpr   | TList !TypeExpr   | TMap !TypeExpr+  | TKeyedMap !Name !TypeExpr   | TRef !Name   deriving stock (Eq, Show, Generic) @@ -819,6 +835,101 @@   }   deriving stock (Eq, Show, Generic) +-- | The frozen Languages 1-5 process form or the declarative Language 6+-- reaction form. Keeping the constructors distinct makes every consumer choose+-- deliberately between positional legacy dispatch and target-keyed reactions.+data ProcessBody+  = LegacyProcessBody !InputDecl !HandleNode !TimerNode+  | ReactionProcessBody !ReactionBody+  deriving stock (Eq, Show, Generic)++data ReactionBody = ReactionBody+  { version :: !Natural,+    versionLoc :: !Loc,+    inputs :: !(NonEmpty InputDecl),+    reactions :: !(NonEmpty ReactionNode),+    timerPolicy :: !(Maybe TimerPolicy),+    timers :: ![ReactionTimerNode]+  }+  deriving stock (Eq, Show, Generic)++data ReactionNode = ReactionNode+  { on :: !Name,+    arms :: !(NonEmpty ReactionArm),+    loc :: !Loc+  }+  deriving stock (Eq, Show, Generic)++data ReactionArm = ReactionArm+  { guard :: !ArmGuard,+    body :: !ArmBody,+    loc :: !Loc+  }+  deriving stock (Eq, Show, Generic)++data ArmGuard+  = UnconditionalArm+  | WhenArm !Expr+  | OtherwiseArm+  deriving stock (Eq, Show, Generic)++data ArmBody+  = NoAction+  | ArmActions+      { advance :: !(Maybe AdvanceReaction),+        followUps :: ![FollowUp]+      }+  deriving stock (Eq, Show, Generic)++data AdvanceReaction = AdvanceReaction+  { command :: !Name,+    fields :: ![FieldBinding],+    accepted :: !(Maybe [FollowUp]),+    silentNoAction :: !Bool,+    loc :: !Loc+  }+  deriving stock (Eq, Show, Generic)++data FollowUp+  = FollowDispatch !DispatchNode+  | FollowSchedule !ScheduleNode+  | FollowCancel !Name !Loc+  deriving stock (Eq, Show, Generic)++data ScheduleNode = ScheduleNode+  { timer :: !Name,+    mode :: !ScheduleMode,+    fireAt :: !FireAtExpr,+    bindings :: ![FieldBinding],+    loc :: !Loc+  }+  deriving stock (Eq, Show, Generic)++data ScheduleMode = ScheduleRearm | ScheduleOnce+  deriving stock (Eq, Show, Generic)++data TimerPolicy = TimerPolicy+  { maxAttempts :: !Int,+    deadLetter :: !Text,+    loc :: !Loc+  }+  deriving stock (Eq, Show, Generic)++data ReactionTimerNode = ReactionTimerNode+  { name :: !Name,+    id :: !IdExpr,+    payload :: ![PayloadField],+    fire :: !FireNode,+    decodeUnknown :: !Name,+    loc :: !Loc+  }+  deriving stock (Eq, Show, Generic)++data PayloadField+  = PayloadConstant !Name !Text+  | PayloadTyped !Name !(Maybe Name)+  deriving stock (Eq, Show, Generic)+ -- | A node-level worker policy lowered to the runtime worker options. data PolicyChoice = PolHalt | PolDeadLetter | PolSkip   deriving stock (Eq, Show, Generic)@@ -830,15 +941,13 @@     id :: !Name,     -- | The define-once ProcessManager @name@ (@name \"hospital-surge\"@).     name :: !Text,-    input :: !InputDecl,     correlate :: !CorrelateDecl,     saga :: !SagaRef,     target :: !Name,     projections :: ![Name],-    handle :: !HandleNode,+    body :: !ProcessBody,     rejected :: !PolicyChoice,     poison :: !PolicyChoice,-    timer :: !TimerNode,     loc :: !Loc   }   deriving stock (Eq, Show, Generic)@@ -924,8 +1033,8 @@  -- EP-4: the cross-service @contract@ (shared Kafka message schema, define-once). --- | A contract field type: @typeid \"inc\"@, @text@, or @int@.-data ContractType = CTypeId !Text | CText | CInt+-- | A contract field type: @typeid \"inc\"@, a declared ID, @text@, or @int@.+data ContractType = CTypeId !Text | CDeclaredId !Name | CText | CInt   deriving stock (Eq, Show, Generic)  data ContractField = ContractField@@ -1009,6 +1118,10 @@ data InkPersist = InkPersistFull | InkPersistDedupeOnly   deriving stock (Eq, Show, Generic) +-- | Which durable state machine owns intake deduplication.+data IdempotenceMode = IdemInboxTable | IdemDelegated+  deriving stock (Eq, Show, Generic)+ -- | An @intake@ (Kafka consumer / inbox) node. The runtime-config @consumer@ -- block (brokers/groupId/offsetReset) is hole-kind 8, delegated to deployment -- and not modelled here.@@ -1020,6 +1133,7 @@     binds :: ![BindRow],     dedupeKey :: !Name,     dedupePolicy :: !Name,+    idempotence :: !IdempotenceMode,     persist :: !InkPersist,     decode :: !DecodeSpec,     disposition :: ![DispositionRow],@@ -1124,7 +1238,7 @@   deriving stock (Eq, Show, Generic)  -- | The queue's semantic delivery-order contract.-data WqOrdering = WqUnordered | WqFifoThroughput | WqFifoRoundRobin+data WqOrdering = WqUnordered | WqFifoThroughput | WqFifoRoundRobin | WqFifoHeads   deriving stock (Eq, Show, Generic)  -- | A FIFO message-group key derived from one payload field.
src/Keiro/Dsl/Harness.hs view
@@ -27,12 +27,14 @@     harnessFor,     harnessForWithGoldens,     harnessProcess,+    harnessProcessForService,     harnessRouter,     harnessRouterForService,     harnessReadModel,     harnessReadModelForService,     harnessWorkflow,     processHarnessFactValues,+    processHarnessFactValuesForService,     routerHarnessFactValues,     routerHarnessFactValuesForService,     workflowHarnessFactValues,@@ -56,6 +58,8 @@ import Keiro.Dsl.HaskellName qualified as HaskellName import Keiro.Dsl.IdDomain (idDomainContractFor, idDomainSampleText) import Keiro.Dsl.NominalType+import Keiro.Dsl.PrettyPrint (renderExpr)+import Keiro.Dsl.ProcessReaction (CheckedProcessReaction (..), checkProcessReaction, processReactionFingerprintFrom) import Keiro.Dsl.ProjectionSupply import Keiro.Dsl.ReadModelShape (registryNameFor) import Keiro.Dsl.RouterSelection@@ -117,7 +121,7 @@ harnessProcess ctx p =   [ ScaffoldModule       { path = T.unpack (T.replace "." "/" genPrefix <> "/ProcessHarness.hs"),-        text = emitProcessHarness genPrefix p,+        text = emitProcessHarness genPrefix (defaultProcessOwnership p) p,         kind = Generated,         origin = "process " <> (.id) p <> locSuffix ((.loc) p)       }@@ -125,6 +129,39 @@   where     genPrefix = genPrefixFor ctx ((.id) p) +-- | Emit process facts from the same checked reaction result used by the+-- ledger, so ownership evidence cannot disagree with validation.+harnessProcessForService :: Context -> CheckedService -> ProcessNode -> [ScaffoldModule]+harnessProcessForService ctx service p =+  [ ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/ProcessHarness.hs"),+        text = emitProcessHarness genPrefix ownership p,+        kind = Generated,+        origin = "process " <> (.id) p <> locSuffix ((.loc) p)+      }+  ]+  where+    genPrefix = genPrefixFor ctx ((.id) p)+    ownership = processOwnershipForService service p++defaultProcessOwnership :: ProcessNode -> Text+defaultProcessOwnership process = case (.body) process of+  LegacyProcessBody {} -> "custom-unverified"+  ReactionProcessBody {} -> "generated-declarative"++processOwnershipForService :: CheckedService -> ProcessNode -> Text+processOwnershipForService service process = case (.body) process of+  LegacyProcessBody {} -> "custom-unverified"+  ReactionProcessBody {} -> case checkedTypeGraph service of+    Left _ -> "custom-unverified"+    Right graph -> case checkProcessReaction (checkedLanguageContract service) graph (checkedSpec service) process of+      Left _ -> "custom-unverified"+      Right checked -> (.verification) checked++processHarnessFactValuesForService :: CheckedService -> ProcessNode -> [(Text, Text)]+processHarnessFactValuesForService service process =+  processHarnessFactValues (processOwnershipForService service process) process+ -- | Emit runtime-free facts for a router's identity, resolution, dispatch, -- and worker-policy decisions. A hand-written conformance driver owns the -- expected values so a spec mutation turns one focused assertion red.@@ -457,8 +494,8 @@       Just RmEntireLog -> "EntireLog"       Just (RmCategory categoryName) -> "CategoryHead " <> categoryName -emitProcessHarness :: Text -> ProcessNode -> Text-emitProcessHarness genPrefix p =+emitProcessHarness :: Text -> Text -> ProcessNode -> Text+emitProcessHarness genPrefix ownership p =   nl $     [ generatedBanner,       "module " <> genPrefix <> ".ProcessHarness (processHarnessValues) where",@@ -472,28 +509,87 @@       "processHarnessValues :: [(String, String)]",       "processHarnessValues ="     ]-      <> renderFactValues (processHarnessFactValues p)+      <> renderFactValues (processHarnessFactValues ownership p) -processHarnessFactValues :: ProcessNode -> [(Text, Text)]-processHarnessFactValues p =-  [ ("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 ((.rejected) p)),-    ("poisonPolicy", showPolicy ((.poison) p)),-    ("maxAttempts", tInt ((.maxAttempts) timer))-  ]+processHarnessFactValues :: Text -> ProcessNode -> [(Text, Text)]+processHarnessFactValues ownership p = case (.body) p of+  ReactionProcessBody reaction -> reactionFacts reaction+  LegacyProcessBody _ handle timer -> legacyFacts handle timer   where-    timer = (.timer) p-    timer' = (.fire) timer-    fd = (.disposition) timer'+    reactionFacts reaction =+      [ ("reactionOwnership", ownership),+        ("reactionVersion", T.pack (show ((.version) reaction))),+        ("reactionFingerprint", processReactionFingerprintFrom reaction)+      ]+        <> concatMap reactionNodeFacts (NE.toList ((.reactions) reaction))+        <> map timerFact ((.timers) reaction)+    reactionNodeFacts node =+      [ ( "reaction." <> (.on) node <> "." <> T.pack (show ordinal),+          T.intercalate+            ";"+            [ "guard=" <> renderArmGuard ((.guard) arm),+              "advance=" <> renderAdvance ((.body) arm),+              "followUps=" <> T.intercalate "," (map renderFollowUpFact (armFollowUps ((.body) arm))),+              "accepted=" <> T.intercalate "," (map renderFollowUpFact (armAccepted ((.body) arm)))+            ]+        )+      | (ordinal, arm) <- zip [0 :: Int ..] (NE.toList ((.arms) node))+      ]+    timerFact timer =+      ( "timer." <> (.name) timer,+        T.intercalate+          ";"+          [ "idPrefix=" <> (.prefix) ((.id) timer),+            "payload=" <> T.intercalate "," (map payloadName ((.payload) timer)),+            "fire=" <> (.target) ((.fire) timer) <> "." <> (.command) ((.fire) timer),+            "firedEventPrefix=" <> (.prefix) ((.firedEventId) ((.fire) timer))+          ]+      )+    payloadName = \case+      PayloadConstant name _ -> name+      PayloadTyped name _ -> name+    renderArmGuard = \case+      UnconditionalArm -> "always"+      OtherwiseArm -> "otherwise"+      WhenArm expression -> renderExpr expression+    renderAdvance = \case+      NoAction -> "none"+      ArmActions {advance = Nothing} -> "none"+      ArmActions {advance = Just value} -> (.command) value+    armFollowUps = \case+      NoAction -> []+      ArmActions {followUps} -> followUps+    armAccepted = \case+      ArmActions {advance = Just value} -> fromMaybe [] ((.accepted) value)+      _ -> []+    renderFollowUpFact = \case+      FollowDispatch dispatch -> "dispatch:" <> (.target) dispatch <> "." <> (.command) dispatch+      FollowSchedule schedule ->+        "schedule:"+          <> (.timer) schedule+          <> ":"+          <> case (.mode) schedule of+            ScheduleRearm -> "rearm"+            ScheduleOnce -> "once"+      FollowCancel timerName _ -> "cancel:" <> timerName+    legacyFacts handle 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 handle))),+        ("rejectedPolicy", showPolicy ((.rejected) p)),+        ("poisonPolicy", showPolicy ((.poison) p)),+        ("maxAttempts", tInt ((.maxAttempts) timer))+      ]+      where+        timer' = (.fire) timer+        fd = (.disposition) timer' -firstDispDisposition :: ProcessNode -> DispatchDisposition-firstDispDisposition p = case (.dispatch) ((.handle) p) of+firstDispDisposition :: HandleNode -> DispatchDisposition+firstDispDisposition handle = case (.dispatch) handle of   (d : _) -> (.disposition) d   [] -> DispatchDisposition DAckOk DAckOk DRetry @@ -1539,10 +1635,13 @@     (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\""-  Nothing -> "error \"optional field lacks on-missing policy\""+        Nothing -> error "Keiro.Dsl.Harness: checked enum default constructor is missing"+      _ -> error "Keiro.Dsl.Harness: checked constructor default does not target an enum"+    (_, RNominal NominalLeaf {kind = NominalEnumLeaf constructors}) -> case lookup constructor (NE.toList constructors) of+      Just wire -> "Aeson.String " <> tshow wire+      Nothing -> error "Keiro.Dsl.Harness: checked nominal enum default constructor is missing"+    _ -> error "Keiro.Dsl.Harness: checked constructor default does not target an enum"+  Nothing -> error "Keiro.Dsl.Harness: checked optional field lacks an on-missing policy"  unknownFieldAssertion :: Agg -> StructuralDecl -> UnknownFields -> Text unknownFieldAssertion aggregate declaration policy =
src/Keiro/Dsl/IdDomain.hs view
@@ -15,6 +15,7 @@   ) where +import Data.List (find) import Data.Text (Text) import Data.Text qualified as T import Keiro.Codec.IdDomain@@ -69,6 +70,10 @@       | NContract contractNode <- (.nodes) spec,         event <- (.events) contractNode,         field <- (.fields) event,-        CTypeId prefix <- [(.valueType) field],+        Just prefix <- [contractFieldPrefix field],         Just contract <- [contractIdDomainContractFor languageContract prefix]       ]+    contractFieldPrefix field = case (.valueType) field of+      CTypeId prefix -> Just prefix+      CDeclaredId name -> (.prefix) <$> find ((== name) . (.name)) ((.ids) spec)+      _ -> Nothing
src/Keiro/Dsl/LanguageVersion.hs view
@@ -141,6 +141,8 @@   | ProjectionCatalogRuntime   | TypedDomainCommandOutcomes   | SeparatedProjectionQueryPolicy+  | DelegatedInboxRuntime+  | StructuralNominalLeaves   deriving stock (Eq, Ord, Show, Enum, Bounded)  -- | An immutable, explicitly named set of runtime capabilities.  The@@ -170,6 +172,9 @@ capabilityFoldSegment ProjectionCatalogRuntime = Just "semantic-contract:keiro-dsl/projection-catalog/1" capabilityFoldSegment TypedDomainCommandOutcomes = Nothing capabilityFoldSegment SeparatedProjectionQueryPolicy = Nothing+capabilityFoldSegment DelegatedInboxRuntime = Nothing+-- Structural nominal leaves change generated codecs, not transition/fold semantics.+capabilityFoldSegment StructuralNominalLeaves = Nothing  runtimeProfileFoldSegments :: RuntimeSemanticsProfile -> [Text] runtimeProfileFoldSegments RuntimeSemanticsProfile {capabilities} =@@ -237,6 +242,9 @@ version5 :: LanguageVersion version5 = LanguageVersion 5 +version6 :: LanguageVersion+version6 = LanguageVersion 6+ -- | The authoritative registry of recognized language contracts. Published -- entries are append-only; any future pre-release candidate is amended in place. languageRegistry :: NonEmpty LanguageDefinition@@ -245,7 +253,8 @@     :| [ LanguageDefinition version2 (Just version1) LanguageBodyParserV2 profileV2 runtimeProfileV1 CompatibilityOnly PublishedLanguage,          LanguageDefinition version3 (Just version2) LanguageBodyParserV2 profileV2 runtimeProfileV2 CompatibilityOnly PublishedLanguage,          LanguageDefinition version4 (Just version3) LanguageBodyParserV2 profileV3 runtimeProfileV3 CompatibilityOnly PublishedLanguage,-         LanguageDefinition version5 (Just version4) LanguageBodyParserV2 profileV4 runtimeProfileV4 Stable PublishedLanguage+         LanguageDefinition version5 (Just version4) LanguageBodyParserV2 profileV4 runtimeProfileV4 Stable PublishedLanguage,+         LanguageDefinition version6 (Just version5) LanguageBodyParserV2 profileV5 runtimeProfileV5 Candidate CandidateLanguage        ]  profileV1 :: SyntaxProfile@@ -290,6 +299,12 @@         )     ) +profileV5 :: SyntaxProfile+profileV5 =+  SyntaxProfile+    "keiro-dsl/syntax-profile/5"+    (Set.insert WorkqueueFifoHeadsSyntax (Set.insert KeyedMapSyntax (Set.insert ContractDeclaredIdSyntax (Set.insert ProcessReactionSyntax (Set.insert DelegatedInboxSyntax ((.features) profileV4))))))+ runtimeProfileV1 :: RuntimeSemanticsProfile runtimeProfileV1 =   RuntimeSemanticsProfile@@ -323,6 +338,12 @@         (Set.insert TypedDomainCommandOutcomes (Set.insert ProjectionCatalogRuntime ((.capabilities) runtimeProfileV3)))     ) +runtimeProfileV5 :: RuntimeSemanticsProfile+runtimeProfileV5 =+  RuntimeSemanticsProfile+    "keiro-dsl/runtime-semantics/5"+    (Set.insert StructuralNominalLeaves (Set.insert DelegatedInboxRuntime ((.capabilities) runtimeProfileV4)))+ -- | Supported versions, derived from 'languageRegistry'. supportedLanguageVersions :: NonEmpty LanguageVersion supportedLanguageVersions = (.version) <$> languageRegistry@@ -366,6 +387,11 @@   | DomainCommandOutcomeSyntax   | DeclarativeRouterSelectionSyntax   | SeparatedProjectionQueryPolicySyntax+  | DelegatedInboxSyntax+  | ProcessReactionSyntax+  | WorkqueueFifoHeadsSyntax+  | ContractDeclaredIdSyntax+  | KeyedMapSyntax   deriving stock (Eq, Ord, Show)  -- | The first released contract that owns each grammar feature.
src/Keiro/Dsl/Manifest.hs view
@@ -131,7 +131,9 @@   NProcess {} -> ["aeson", "keiki", "keiro", "shibuya-core", "text", "time", "uuid"]   NRouter {} -> ["effectful-core", "keiro", "shibuya-core", "text"]   NContract contract -> ["aeson", "text"] <> [dependency | hasTypedContractId contract, dependency <- ["keiro-core", "mmzk-typeid"]]-  NIntake {} -> integration+  NIntake intake -> case (.idempotence) intake of+    IdemInboxTable -> integration+    IdemDelegated -> ["effectful-core", "keiro", "keiro-core", "text"]   NEmit {} -> integration   NPublisher {} -> integration   NWorkqueue workqueue -> ["aeson", "keiro-core", "keiro-pgmq", "text"] <> workqueueDependencies workqueue@@ -148,10 +150,12 @@     integration = ["effectful-core", "hasql-transaction", "keiro", "kiroku-store"]     hasTypedContractId contract =       or-        [ contractIdDomainContractFor (checkedLanguageContract service) prefix /= Nothing+        [ case (.valueType) field of+            CTypeId prefix -> contractIdDomainContractFor (checkedLanguageContract service) prefix /= Nothing+            CDeclaredId {} -> True+            _ -> False         | event <- (.events) contract,-          field <- (.fields) event,-          CTypeId prefix <- [(.valueType) field]+          field <- (.fields) event         ]  workqueueDependencies :: WorkqueueNode -> [Text]@@ -160,7 +164,8 @@     <> ["time" | any (typeExprUses isTime) expressions]   where     expressions = [expression | field <- (.payload) workqueue, TypedQueueExpression expression <- [(.valueType) field]]-    isMap (TMap _) = True+    isMap TMap {} = True+    isMap TKeyedMap {} = True     isMap _ = False     isTime TTime = True     isTime _ = False@@ -170,6 +175,7 @@           TOptional value -> typeExprUses predicate value           TList value -> typeExprUses predicate value           TMap value -> typeExprUses predicate value+          TKeyedMap _ value -> typeExprUses predicate value           _ -> False  readModelDependencies :: ReadModelNode -> [Text]@@ -184,6 +190,7 @@     isJson TJson = True     isJson _ = False     isMap TMap {} = True+    isMap TKeyedMap {} = True     isMap _ = False     isTime TTime = True     isTime _ = False@@ -193,6 +200,7 @@           TOptional value -> typeExprUses predicate value           TList value -> typeExprUses predicate value           TMap value -> typeExprUses predicate value+          TKeyedMap _ value -> typeExprUses predicate value           _ -> False  aggregateDependencies :: CheckedService -> Aggregate -> [Text]
src/Keiro/Dsl/MappedCodecPlan.hs view
@@ -18,6 +18,7 @@ import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text)+import Data.Text qualified as T import Keiro.Dsl.ConsumerTypePlan import Keiro.Dsl.TypeGraph @@ -26,6 +27,7 @@   | ExplicitJsonAuthority   | StructuralAuthority !MappedKey   | OpaqueAuthority !MappedKey+  | NominalAuthority !Text   deriving stock (Eq, Ord, Show)  -- | A consumer root crosses a declared total binding for structural@@ -69,68 +71,134 @@           onOptional = id,           onList = id,           onMap = id,+          onKeyedMap = \key value -> Set.insert (NominalAuthority ((.name) key)) value,           onRef = \key -> case Map.lookup key ((.declarations) graph) of             Just ResolvedStructural {} -> Set.singleton (StructuralAuthority key)             Just ResolvedOpaque {} -> Set.singleton (OpaqueAuthority key)-            Nothing -> Set.empty+            Nothing -> error ("keiro-dsl internal invariant: mapped codec plan references missing declaration " <> show key),+          onNominal = Set.singleton . NominalAuthority . (.name)         }  renderMappedEncode :: TypeGraph -> MappedReferenceBoundary -> MappedCodecPlan -> Text -> Text-renderMappedEncode graph boundary plan value =-  foldTypeExpr-    TypeExprAlgebra-      { onText = primitive,-        onInt = primitive,-        onInteger = primitive,-        onBool = primitive,-        onNatural = primitive,-        onTime = primitive,-        onJson = id,-        onOptional = \encode candidate -> "maybe Null (\\item -> " <> encode "item" <> ") (" <> candidate <> ")",-        onList = \encode candidate -> "toJSON (map (\\item -> " <> encode "item" <> ") (" <> candidate <> "))",-        onMap = \encode candidate -> "toJSON (Map.map (\\item -> " <> encode "item" <> ") (" <> candidate <> "))",-        onRef = encodeReference-      }-    ((.resolvedExpression) plan)-    value+renderMappedEncode graph boundary plan = render (0 :: Int) ((.resolvedExpression) plan)   where+    render depth expression candidate = case expression of+      RText -> primitive candidate+      RInt -> primitive candidate+      RInteger -> primitive candidate+      RBool -> primitive candidate+      RNatural -> primitive candidate+      RTime -> primitive candidate+      RJson -> candidate+      ROptional nested ->+        "maybe Null (\\" <> item depth <> " -> " <> render (depth + 1) nested (item depth) <> ") (" <> candidate <> ")"+      RList nested ->+        "toJSON (map (\\" <> item depth <> " -> " <> render (depth + 1) nested (item depth) <> ") (" <> candidate <> "))"+      RMap nested ->+        "toJSON (Map.map (\\" <> item depth <> " -> " <> render (depth + 1) nested (item depth) <> ") (" <> candidate <> "))"+      RKeyedMap keyLeaf nested ->+        "Object (KeyMap.fromList [(Key.fromText (render"+          <> (.name) keyLeaf+          <> "LeafKey "+          <> key depth+          <> "), "+          <> render (depth + 1) nested (item depth)+          <> ") | ("+          <> key depth+          <> ", "+          <> item depth+          <> ") <- Map.toList ("+          <> candidate+          <> ")])"+      RRef referenceKey -> encodeReference referenceKey candidate+      RNominal leaf -> "encode" <> (.name) leaf <> "Leaf " <> candidate     primitive candidate = "toJSON (" <> candidate <> ")"-    encodeReference key candidate = case Map.lookup key ((.declarations) graph) of+    encodeReference referenceKey candidate = case Map.lookup referenceKey ((.declarations) graph) of       Just (ResolvedStructural declaration _) ->         "encode" <> (.name) declaration <> suffix <> argument candidate       Just ResolvedOpaque {} -> case boundary of         ConsumerValueBoundary -> "toJSON " <> candidate         StructuralShapeBoundary -> primitive candidate-      Nothing -> primitive candidate+      Nothing -> error ("keiro-dsl internal invariant: mapped encoder references missing declaration " <> show referenceKey)     argument candidate = case boundary of       ConsumerValueBoundary -> " " <> candidate       StructuralShapeBoundary -> " (" <> candidate <> ")"     suffix = case boundary of       ConsumerValueBoundary -> "Mapped"       StructuralShapeBoundary -> "Shape"+    item depth = "item" <> tshow depth+    key depth = "key" <> tshow depth  renderMappedParse :: TypeGraph -> MappedReferenceBoundary -> MappedCodecPlan -> Text-renderMappedParse graph boundary plan =-  foldTypeExpr-    TypeExprAlgebra-      { onText = "parseJSON",-        onInt = "parseJSON",-        onInteger = "parseJSON",-        onBool = "parseJSON",-        onNatural = "parseJSON",-        onTime = "parseJSON",-        onJson = "pure",-        onOptional = \decode -> "\\value -> case value of Null -> pure Nothing; other -> Just <$> " <> decode <> " other",-        onList = \decode -> "\\value -> (parseJSON value :: Parser [Value]) >>= traverse (" <> decode <> ")",-        onMap = \decode -> "\\value -> (parseJSON value :: Parser (Map Text Value)) >>= traverse (" <> decode <> ")",-        onRef = parseReference-      }-    ((.resolvedExpression) plan)+renderMappedParse graph boundary plan = render (0 :: Int) ((.resolvedExpression) plan)   where-    parseReference key = case Map.lookup key ((.declarations) graph) of+    render depth = \case+      RText -> "parseJSON"+      RInt -> "parseJSON"+      RInteger -> "parseJSON"+      RBool -> "parseJSON"+      RNatural -> "parseJSON"+      RTime -> "parseJSON"+      RJson -> "pure"+      ROptional nested ->+        "\\" <> value depth <> " -> case " <> value depth <> " of Null -> pure Nothing; " <> other depth <> " -> Just <$> (" <> render (depth + 1) nested <> ") " <> other depth+      RList nested ->+        "\\" <> value depth <> " -> do " <> items depth <> " <- (parseJSON " <> value depth <> " :: Parser [Value]); traverse (\\(" <> index depth <> ", " <> item depth <> ") -> (" <> render (depth + 1) nested <> ") " <> item depth <> " <?> Index " <> index depth <> ") (zip [0..] " <> items depth <> ")"+      RMap nested ->+        "\\" <> value depth <> " -> do " <> items depth <> " <- (parseJSON " <> value depth <> " :: Parser (Map Text Value)); Map.traverseWithKey (\\" <> key depth <> " " <> item depth <> " -> (" <> render (depth + 1) nested <> ") " <> item depth <> " <?> Key (Key.fromText " <> key depth <> ")) " <> items depth+      RKeyedMap keyLeaf nested ->+        "\\"+          <> value depth+          <> " -> withObject "+          <> tshow ("Map[" <> (.name) keyLeaf <> "]")+          <> " (\\"+          <> object depth+          <> " -> Map.fromList <$> traverse (\\("+          <> rawKey depth+          <> ", "+          <> item depth+          <> ") -> do "+          <> key depth+          <> " <- parse"+          <> (.name) keyLeaf+          <> "LeafKey (Key.toText "+          <> rawKey depth+          <> ") <?> Key "+          <> rawKey depth+          <> "; "+          <> parsedItem depth+          <> " <- ("+          <> render (depth + 1) nested+          <> ") "+          <> item depth+          <> " <?> Key "+          <> rawKey depth+          <> "; pure ("+          <> key depth+          <> ", "+          <> parsedItem depth+          <> ")) (KeyMap.toList "+          <> object depth+          <> ")) "+          <> value depth+      RRef keyValue -> parseReference keyValue+      RNominal leaf -> "parse" <> (.name) leaf <> "Leaf"+    parseReference mappedKey = case Map.lookup mappedKey ((.declarations) graph) of       Just (ResolvedStructural declaration _) -> "parse" <> (.name) declaration <> suffix       Just ResolvedOpaque {} -> "parseJSON"-      Nothing -> "parseJSON"+      Nothing -> error ("keiro-dsl internal invariant: mapped parser references missing declaration " <> show mappedKey)     suffix = case boundary of       ConsumerValueBoundary -> "Mapped"       StructuralShapeBoundary -> "Shape"+    value depth = "value" <> tshow depth+    other depth = "other" <> tshow depth+    items depth = "items" <> tshow depth+    index depth = "index" <> tshow depth+    item depth = "item" <> tshow depth+    key depth = "key" <> tshow depth+    rawKey depth = "rawKey" <> tshow depth+    parsedItem depth = "parsedItem" <> tshow depth+    object depth = "object" <> tshow depth++tshow :: (Show value) => value -> Text+tshow = T.pack . show
src/Keiro/Dsl/MappedDiff.hs view
@@ -87,7 +87,9 @@   | ExprOptional !ExprView   | ExprList !ExprView   | ExprMap !ExprView+  | ExprKeyedMap !Name !ExprView   | ExprRef !MappedKey+  | ExprNominal !Name   deriving stock (Eq, Show)  declView :: ResolvedMappedDecl -> DeclView@@ -121,7 +123,9 @@         onOptional = ExprOptional,         onList = ExprList,         onMap = ExprMap,-        onRef = ExprRef+        onKeyedMap = \key -> ExprKeyedMap ((.name) key),+        onRef = ExprRef,+        onNominal = ExprNominal . (.name)       }  diffDeclaration :: TypeGraph -> TypeGraph -> ResolvedMappedDecl -> ResolvedMappedDecl -> [MappedFinding]
src/Keiro/Dsl/NominalType.hs view
@@ -27,7 +27,6 @@   ) where -import Data.Char (isAscii, isDigit, isLower, isUpper, ord) import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map)@@ -35,23 +34,13 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T-import Data.TypeID qualified as TypeID import GHC.Generics (Generic) import Keiro.Dsl.Grammar-import Keiro.Dsl.HaskellName (haskellKeywords) import Keiro.Dsl.IdDomain (enforcedIdDomainVersion) import Keiro.Dsl.LanguageVersion (RuntimeCapability (..), runtimeProfileHasCapability) import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedSpec) import Keiro.Dsl.TypeGraph -data NominalScalarRepresentation-  = NominalText-  | NominalInt-  | NominalNatural-  | NominalBool-  | NominalTime-  deriving stock (Eq, Ord, Show, Generic)- data NominalRepresentation   = IdRepresentation !Text   | EnumRepresentation !(NonEmpty (Name, Text))@@ -84,16 +73,6 @@   }   deriving stock (Eq, Ord, Show, Generic) -data ConsumerNominalBinding = ConsumerNominalBinding-  { haskell :: !HaskellSource,-    binding :: !QualifiedValueName,-    bindingVersion :: !BindingVersion,-    canonical :: !CanonicalTypeId,-    fixtures :: !QualifiedValueName,-    initial :: !(Maybe QualifiedValueName)-  }-  deriving stock (Eq, Ord, Show, Generic)- data NominalOwnership   = GeneratedNominal   | ConsumerNominal !ConsumerNominalBinding@@ -223,37 +202,17 @@     declarationErrors = concatMap fst declarationResults     resolvedDeclarations = [value | (_, Just value) <- declarationResults] -    resolveId declaration =-      let name = (.name) declaration-          loc = (.loc) declaration-          prefixErrors =-            case (.binding) declaration >>= const (TypeID.checkPrefix ((.prefix) declaration)) of-              Nothing -> []-              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 ((.prefix) declaration)) <$> ownership <*> pure loc-       in (errors, value <* guardNoErrors errors)+    resolveId declaration = case checkIdLeaf declaration of+      Left leafError -> (map leafIssueToNominalError (NE.toList ((.nominalLeafIssues) leafError)), Nothing)+      Right leaf -> ([], Just (resolvedFromLeaf leaf)) -    resolveEnum declaration =-      let name = (.name) declaration-          loc = (.loc) declaration-          representation = NE.nonEmpty ((.ctors) declaration)-          representationErrors = [NominalEmptyEnum name loc | representation == Nothing]-          (bindingErrors, ownership) = resolveOwnership name loc ((.binding) declaration)-          errors = representationErrors <> bindingErrors-          value = ResolvedNominalType name <$> (EnumRepresentation <$> representation) <*> ownership <*> pure loc-       in (errors, value <* guardNoErrors errors)+    resolveEnum declaration = case checkEnumLeaf declaration of+      Left leafError -> (map leafIssueToNominalError (NE.toList ((.nominalLeafIssues) leafError)), Nothing)+      Right leaf -> ([], Just (resolvedFromLeaf leaf)) -    resolveScalar 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)+    resolveScalar declaration = case checkScalarLeaf declaration of+      Left leafError -> (map leafIssueToNominalError (NE.toList ((.nominalLeafIssues) leafError)), Nothing)+      Right leaf -> ([], Just (resolvedFromLeaf leaf))      collisionErrors =       [ NominalDeclarationCollision name loc categories@@ -281,78 +240,29 @@         (.initial) binding == Nothing       ] -resolveOwnership :: Name -> Loc -> Maybe NominalBindingDecl -> ([NominalTypeError], Maybe NominalOwnership)-resolveOwnership _ _ Nothing = ([], Just GeneratedNominal)-resolveOwnership name loc (Just binding) = resolveRequiredOwnership name loc binding--resolveRequiredOwnership :: Name -> Loc -> NominalBindingDecl -> ([NominalTypeError], Maybe NominalOwnership)-resolveRequiredOwnership name loc binding =-  (errors, ConsumerNominal <$> checkedBinding <* guardNoErrors errors)-  where-    requiredErrors =-      [NominalMissingIngredient name loc label | (label, missing) <- missingFacts, missing]-    missingFacts =-      [ ("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) ((.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-        <$> (.haskell) binding-        <*> checkedBindingName-        <*> checkedBindingVersion-        <*> checkedCanonical-        <*> checkedFixtures-        <*> pure checkedInitial--validateHaskellSource :: Name -> Loc -> HaskellSource -> [NominalTypeError]-validateHaskellSource name loc 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)-validateQualified name loc category (Just value) =-  case mkQualifiedValueName value of-    Right checked | qualifiedValueSafe value -> ([], Just checked)-    _ -> ([NominalInvalidQualifiedValue name loc category value], Nothing)--validateOptionalQualified :: Name -> Loc -> Text -> Maybe Text -> ([NominalTypeError], Maybe QualifiedValueName)-validateOptionalQualified = validateQualified--validateBindingVersion :: Name -> Loc -> Maybe Text -> ([NominalTypeError], Maybe BindingVersion)-validateBindingVersion _ _ Nothing = ([], Nothing)-validateBindingVersion name loc (Just value) =-  case mkBindingVersion value of-    Right checked | identitySafe value -> ([], Just checked)-    _ -> ([NominalInvalidIdentity name loc "binding-version" value], Nothing)--validateCanonical :: Name -> Loc -> Maybe Text -> ([NominalTypeError], Maybe CanonicalTypeId)-validateCanonical _ _ Nothing = ([], Nothing)-validateCanonical name loc (Just value) =-  case mkCanonicalTypeId value of-    Right checked | identitySafe value -> ([], Just checked)-    _ -> ([NominalInvalidIdentity name loc "canonical-type" value], Nothing)+resolvedFromLeaf :: NominalLeaf -> ResolvedNominalType+resolvedFromLeaf leaf =+  ResolvedNominalType+    { name = (.name) leaf,+      representation = case (.kind) leaf of+        NominalIdLeaf prefix -> IdRepresentation prefix+        NominalEnumLeaf constructors -> EnumRepresentation constructors+        NominalScalarLeaf representation -> ScalarRepresentation representation,+      ownership = case (.ownership) leaf of+        GeneratedLeaf -> GeneratedNominal+        ConsumerLeaf binding -> ConsumerNominal binding,+      loc = (.loc) leaf+    } -scalarRepresentation :: Name -> Maybe NominalScalarRepresentation-scalarRepresentation = \case-  "Text" -> Just NominalText-  "Int" -> Just NominalInt-  "Natural" -> Just NominalNatural-  "Bool" -> Just NominalBool-  "Time" -> Just NominalTime-  "UTCTime" -> Just NominalTime-  _ -> Nothing+leafIssueToNominalError :: NominalLeafIssue -> NominalTypeError+leafIssueToNominalError = \case+  LeafMissingIngredient name loc label -> NominalMissingIngredient name loc label+  LeafInvalidHaskellSource name loc label -> NominalInvalidHaskellSource name loc label+  LeafInvalidQualifiedValue name loc category value -> NominalInvalidQualifiedValue name loc category value+  LeafInvalidIdentity name loc category value -> NominalInvalidIdentity name loc category value+  LeafInvalidIdPrefix name loc prefix reason -> NominalInvalidIdPrefix name loc prefix reason+  LeafEmptyEnum name loc -> NominalEmptyEnum name loc+  LeafUnsupportedScalar name loc representation -> NominalUnsupportedScalar name loc representation  rejectErrors :: [e] -> [a] -> Either (NonEmpty e) [a] rejectErrors errors values = maybe (Right values) Left (NE.nonEmpty errors)@@ -360,10 +270,6 @@ rejectMany :: [e] -> Either (NonEmpty e) () rejectMany errors = maybe (Right ()) Left (NE.nonEmpty errors) -guardNoErrors :: [e] -> Maybe ()-guardNoErrors [] = Just ()-guardNoErrors _ = Nothing- mappedName :: MappedDecl -> Name mappedName MappedStructural {msName = name} = name mappedName MappedOpaque {moName = name} = name@@ -391,40 +297,3 @@   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-  where-    components = T.splitOn "-" packageName-    validComponent component = not (T.null component) && T.all asciiAlphaNum component && T.any asciiLetter component--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--constructorSafe :: Text -> Bool-constructorSafe name = case T.uncons name of-  Just (first, rest) -> asciiUpper first && T.all asciiAlphaNumOrUnderscore rest-  Nothing -> False--lowerIdentifierSafe :: Text -> Bool-lowerIdentifierSafe name = case T.uncons name of-  Just (first, rest) -> asciiLower first && T.all asciiAlphaNumOrUnderscore rest && name `Set.notMember` haskellKeywords-  Nothing -> False--identitySafe :: Text -> Bool-identitySafe value = not (T.null (T.strip value)) && not (T.any asciiControl value)--asciiUpper, asciiLower, asciiLetter, asciiAlphaNum, asciiAlphaNumOrUnderscore, asciiControl :: Char -> Bool-asciiUpper c = isAscii c && isUpper c-asciiLower c = isAscii c && isLower c-asciiLetter c = asciiUpper c || asciiLower c-asciiAlphaNum c = asciiLetter c || (isAscii c && isDigit c)-asciiAlphaNumOrUnderscore c = asciiAlphaNum c || c == '_'-asciiControl c = ord c < 32 || ord c == 127
src/Keiro/Dsl/Parser/Coordination.hs view
@@ -6,28 +6,52 @@ where  import Data.List (intersperse)+import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Data.Text qualified as T import Keiro.Dsl.Frontend.Internal (FrontendContext) import Keiro.Dsl.Grammar-import Keiro.Dsl.LanguageVersion (LanguageFeature (DeclarativeRouterSelectionSyntax))+import Keiro.Dsl.LanguageVersion (LanguageFeature (DeclarativeRouterSelectionSyntax, ProcessReactionSyntax)) import Keiro.Dsl.Parser.Core import Keiro.Dsl.Parser.Expression (pExpr) import Keiro.Dsl.Parser.Mapped (pMappedTypeExpr)-import Keiro.Dsl.Source (SourceSpan)+import Keiro.Dsl.Source (Located (..), SourceSpan)+import Keiro.Dsl.Syntax (SurfaceElement (..)) import Text.Megaparsec import Text.Megaparsec.Char (char)  -- Process manager + durable timer (EP-3) -------------------------------------------------------------------------------- -pProcess :: P ProcessNode-pProcess = do+pProcess :: FrontendContext -> P (ProcessNode, [Located SurfaceElement])+pProcess context = do   loc <- getLoc   keyword "process"   pid <- ident   keyword "name"   nm <- stringLit+  (processBody, corr, saga, tgt, projs, rejected, poison, reactionSpans) <- try (pReactionProcessBody context) <|> pLegacyProcessBody+  let processNode =+        ProcessNode+          { id = pid,+            name = nm,+            correlate = corr,+            saga = saga,+            target = tgt,+            projections = projs,+            body = processBody,+            rejected = rejected,+            poison = poison,+            loc = loc+          }+      elements =+        [ Located {span = sourceSpan, value = SurfaceProcessReaction pid inputName ordinal}+        | (inputName, ordinal, sourceSpan) <- reactionSpans+        ]+  pure (processNode, elements)++pLegacyProcessBody :: P (ProcessBody, CorrelateDecl, SagaRef, Name, [Name], PolicyChoice, PolicyChoice, [(Name, Int, SourceSpan)])+pLegacyProcessBody = do   inp <- pInputDecl   corr <- pCorrelate   saga <- pSaga@@ -39,21 +63,161 @@   rejected <- pPolicyLine "rejected"   poison <- pPolicyLine "poison"   timer <- pTimerNode+  pure (LegacyProcessBody inp handle timer, corr, saga, tgt, projs, rejected, poison, [])++pReactionProcessBody :: FrontendContext -> P (ProcessBody, CorrelateDecl, SagaRef, Name, [Name], PolicyChoice, PolicyChoice, [(Name, Int, SourceSpan)])+pReactionProcessBody context = do+  marker <- withOwnedSpan (keyword "reactions")+  requireLanguageFeatureAt context ProcessReactionSyntax (spanOf marker)+  versionLoc <- getLoc+  keyword "version"+  reactionVersion <- fromIntegral <$> boundedDecimal+  inputs <- NE.fromList <$> some pInputDecl+  corr <- pCorrelate+  saga <- pSaga+  keyword "target"+  tgt <- ident+  projs <- keyword "projections" *> brackets (many ident)+  parsedReactions <- some (pReactionNode context)+  let reactions = NE.fromList (map fst parsedReactions)+      reactionSpans = numberReactionSpans (concatMap snd parsedReactions)+  pFixedDispatchIdLine ["name", "correlationId", "sourceEventId", "targetStreamName", "occurrence"]+  rejected <- pPolicyLine "rejected"+  poison <- pPolicyLine "poison"+  policy <- optional pTimerPolicy+  timers <- many pReactionTimerNode   pure-    ProcessNode-      { id = pid,-        name = nm,-        input = inp,-        correlate = corr,-        saga = saga,-        target = tgt,-        projections = projs,-        handle = handle,-        rejected = rejected,-        poison = poison,-        timer = timer,+    ( ReactionProcessBody+        ReactionBody+          { version = reactionVersion,+            versionLoc = versionLoc,+            inputs = inputs,+            reactions = reactions,+            timerPolicy = policy,+            timers = timers+          },+      corr,+      saga,+      tgt,+      projs,+      rejected,+      poison,+      reactionSpans+    )+  where+    numberReactionSpans raw =+      [ (inputName, length [() | (priorName, _, _) <- take index raw, priorName == inputName], sourceSpan)+      | (index, (inputName, _, sourceSpan)) <- zip [0 ..] raw+      ]++pReactionNode :: FrontendContext -> P (ReactionNode, [(Name, Int, SourceSpan)])+pReactionNode context = do+  loc <- getLoc+  keyword "on"+  inputName <- ident+  firstIsGuarded <- optional (lookAhead (keyword "when" <|> keyword "otherwise"))+  locatedArms <- case firstIsGuarded of+    Just _ -> some (withOwnedSpan (pGuardedReactionArm context))+    Nothing -> (: []) <$> withOwnedSpan pUnconditionalReactionArm+  let arms = NE.fromList [arm | Located {value = arm} <- locatedArms]+      spans = [(inputName, ordinal, spanOf arm) | (ordinal, arm) <- zip [0 ..] locatedArms]+  pure (ReactionNode {on = inputName, arms = arms, loc = loc}, spans)++pGuardedReactionArm :: FrontendContext -> P ReactionArm+pGuardedReactionArm context = do+  loc <- getLoc+  armGuard <-+    (WhenArm <$> (keyword "when" *> pExpr context))+      <|> (OtherwiseArm <$ keyword "otherwise")+  armBody <- pReactionArmBody+  pure ReactionArm {guard = armGuard, body = armBody, loc = loc}++pUnconditionalReactionArm :: P ReactionArm+pUnconditionalReactionArm = do+  loc <- getLoc+  armBody <- pReactionArmBody+  pure ReactionArm {guard = UnconditionalArm, body = armBody, loc = loc}++pReactionArmBody :: P ArmBody+pReactionArmBody =+  (NoAction <$ (keyword "no-action"))+    <|> do+      advance <- optional pAdvanceReaction+      followUps <- many pFollowUp+      case (advance, followUps) of+        (Nothing, []) -> fail "reaction arm must declare advance, a follow-up, or no-action"+        _ -> pure ArmActions {advance = advance, followUps = followUps}++pAdvanceReaction :: P AdvanceReaction+pAdvanceReaction = do+  loc <- getLoc+  keyword "advance"+  command <- ident+  fields <- braces (many pFieldBinding)+  acceptedBlock <- optional $ do+    keyword "accepted"+    acceptedFollowUps <- many pFollowUp+    silent <- optional (keyword "silent" *> keyword "no-action")+    pure (acceptedFollowUps, maybe False (const True) silent)+  pure+    AdvanceReaction+      { command = command,+        fields = fields,+        accepted = fst <$> acceptedBlock,+        silentNoAction = maybe False snd acceptedBlock,         loc = loc       }++pFollowUp :: P FollowUp+pFollowUp =+  choice+    [ FollowDispatch <$> try pDispatch,+      FollowSchedule <$> try pSchedule,+      do+        loc <- getLoc+        keyword "cancel"+        FollowCancel <$> ident <*> pure loc+    ]++pSchedule :: P ScheduleNode+pSchedule = do+  loc <- getLoc+  keyword "schedule"+  timer <- ident+  mode <- maybe ScheduleRearm (const ScheduleOnce) <$> optional (keyword "once")+  fireAt <- keyword "fireAt" *> pFireAt+  bindings <- braces (many pFieldBinding)+  pure ScheduleNode {timer = timer, mode = mode, fireAt = fireAt, bindings = bindings, loc = loc}++pTimerPolicy :: P TimerPolicy+pTimerPolicy = do+  loc <- getLoc+  keyword "timers"+  keyword "max-attempts"+  maxAttempts <- boundedDecimal+  keyword "dead-letter"+  deadLetter <- stringLit+  pure TimerPolicy {maxAttempts = maxAttempts, deadLetter = deadLetter, loc = loc}++pReactionTimerNode :: P ReactionTimerNode+pReactionTimerNode = do+  loc <- getLoc+  keyword "timer"+  name <- ident+  timerId <- keyword "id" *> pIdExpr+  payload <- keyword "payload" *> braces (many pPayloadField)+  fire <- pFire+  _ <- keyword "decode" *> keyword "unknown-status" *> symbol "=>"+  decodeUnknown <- ident+  pure ReactionTimerNode {name = name, id = timerId, payload = payload, fire = fire, decodeUnknown = decodeUnknown, loc = loc}++pPayloadField :: P PayloadField+pPayloadField = do+  name <- ident+  choice+    [ PayloadConstant name <$> (symbol "=" *> stringLit),+      PayloadTyped name <$> optional (symbol ":" *> ident)+    ]  pRouter :: FrontendContext -> P RouterNode pRouter context = do
src/Keiro/Dsl/Parser/Document.hs view
@@ -127,9 +127,11 @@         plain (pMappedTopItem context)       ]         ++ [ plain (SurfaceNode . NRouter <$> pRouter context),-             plain (SurfaceNode . NProcess <$> pProcess),+             do+               (process, elements) <- pProcess context+               pure (ParsedTopItem (SurfaceNode (NProcess process)) elements),              plain (SurfaceNode . NContract <$> pContract context),-             plain (SurfaceNode . NIntake <$> pIntake),+             plain (SurfaceNode . NIntake <$> pIntake context),              plain (SurfaceNode . NEmit <$> pEmit),              plain (SurfaceNode . NPublisher <$> pPublisher),              plain (SurfaceNode . NWorkqueue <$> pWorkqueue context),
src/Keiro/Dsl/Parser/Integration.hs view
@@ -9,7 +9,7 @@  import Keiro.Dsl.Frontend.Internal (FrontendContext) import Keiro.Dsl.Grammar-import Keiro.Dsl.LanguageVersion (LanguageFeature (FieldAliasSyntax))+import Keiro.Dsl.LanguageVersion (LanguageFeature (ContractDeclaredIdSyntax, DelegatedInboxSyntax, FieldAliasSyntax)) import Keiro.Dsl.Parser.Core import Text.Megaparsec @@ -64,11 +64,15 @@       choice         [ CTypeId <$> (keyword "typeid" *> stringLit),           CText <$ keyword "text",-          CInt <$ keyword "int"+          CInt <$ keyword "int",+          do+            declaredId <- withOwnedSpan ident+            requireLanguageFeatureAt context ContractDeclaredIdSyntax (spanOf declaredId)+            pure (CDeclaredId (locatedValue declaredId))         ] -pIntake :: P IntakeNode-pIntake = do+pIntake :: FrontendContext -> P IntakeNode+pIntake context = do   loc <- getLoc   keyword "intake"   nm <- ident@@ -85,6 +89,19 @@   dk <- ident   keyword "policy"   dp <- ident+  idem <-+    maybe IdemInboxTable id+      <$> optionalLanguageFeature+        context+        DelegatedInboxSyntax+        "idempotence"+        ( try $ do+            keyword "idempotence"+            choice+              [ IdemInboxTable <$ keyword "table",+                IdemDelegated <$ keyword "delegated"+              ]+        )   persistence <-     option InkPersistFull $       keyword "persist"@@ -105,6 +122,7 @@         binds = binds,         dedupeKey = dk,         dedupePolicy = dp,+        idempotence = idem,         persist = persistence,         decode = dec,         disposition = disp,
src/Keiro/Dsl/Parser/Mapped.hs view
@@ -264,7 +264,7 @@   choice     [ TOptional <$> (keyword "Optional" *> pTypeArgument),       TList <$> (keyword "List" *> pTypeArgument),-      TMap <$> (keyword "Map" *> pTypeArgument),+      keyword "Map" *> pMapType,       TText <$ keyword "Text",       TInt <$ keyword "Int",       TInteger <$ languageFeatureKeyword context IntegerScalarSyntax "Integer",@@ -275,6 +275,13 @@       TRef <$> ident     ]   where+    pMapType = do+      keyed <- optional (withOwnedSpan (symbol "[" *> ident <* symbol "]"))+      case keyed of+        Nothing -> TMap <$> pTypeArgument+        Just locatedKey -> do+          requireLanguageFeatureAt context KeyedMapSyntax (spanOf locatedKey)+          TKeyedMap (locatedValue locatedKey) <$> pTypeArgument     pTypeArgument = parens (pMappedTypeExpr context) <|> pTypeAtom     pTypeAtom =       choice
src/Keiro/Dsl/Parser/Queue.hs view
@@ -7,7 +7,7 @@  import Keiro.Dsl.Frontend.Internal (FrontendContext) import Keiro.Dsl.Grammar-import Keiro.Dsl.LanguageVersion (LanguageFeature (MappedConsumerSurfaceSyntax))+import Keiro.Dsl.LanguageVersion (LanguageFeature (MappedConsumerSurfaceSyntax, WorkqueueFifoHeadsSyntax)) import Keiro.Dsl.Parser.Core import Keiro.Dsl.Parser.Mapped (pMappedTypeExpr) import Text.Megaparsec@@ -68,7 +68,11 @@       choice         [ WqUnordered <$ symbol "unordered",           WqFifoThroughput <$ symbol "fifo-throughput",-          WqFifoRoundRobin <$ symbol "fifo-roundrobin"+          WqFifoRoundRobin <$ symbol "fifo-roundrobin",+          do+            marker <- withOwnedSpan (symbol "fifo-heads")+            requireLanguageFeatureAt context WorkqueueFifoHeadsSyntax (spanOf marker)+            pure WqFifoHeads         ]     pGroupKey = do       _ <- symbol "group" *> symbol "key" *> symbol "from"
src/Keiro/Dsl/PrettyPrint.hs view
@@ -12,12 +12,18 @@     renderExpr,     renderTypeExpr,     renderHandleSurface,+    renderReactionArmBodySurface,+    renderReactionArmGuardSurface,+    renderReactionArmSurface,+    renderReactionSurface,+    renderReactionTimerPayloadSurface,     renderResolveSurface,     renderRouterDispatchSurface,     renderTimerPayloadSurface,   ) where +import Data.List.NonEmpty qualified as NE import Data.Text (Text) import Data.Text qualified as T import Keiro.Dsl.Grammar@@ -40,6 +46,25 @@ renderHandleSurface :: HandleNode -> Text renderHandleSurface = renderDoc . docHandle +renderReactionSurface :: ReactionBody -> Text+renderReactionSurface = renderDoc . docReactionBody++renderReactionArmSurface :: ReactionArm -> Text+renderReactionArmSurface = renderDoc . docReactionArm++renderReactionArmGuardSurface :: ReactionArm -> Text+renderReactionArmGuardSurface arm = case (.guard) arm of+  UnconditionalArm -> "unconditional"+  WhenArm expression -> renderDoc ("when" <+> docExpr 0 expression)+  OtherwiseArm -> "otherwise"++renderReactionArmBodySurface :: ReactionArm -> Text+renderReactionArmBodySurface = renderDoc . docArmBody . (.body)++renderReactionTimerPayloadSurface :: ReactionTimerNode -> Text+renderReactionTimerPayloadSurface timer =+  renderDoc ("payload" <+> braced (map docPayloadField ((.payload) timer)))+ renderResolveSurface :: ResolveDecl -> Text renderResolveSurface = renderDoc . docResolve @@ -242,12 +267,14 @@ docTypeExpr (TOptional value) = "Optional" <+> docTypeArgument value docTypeExpr (TList value) = "List" <+> docTypeArgument value docTypeExpr (TMap value) = "Map" <+> docTypeArgument value+docTypeExpr (TKeyedMap key value) = "Map[" <> pretty key <> "]" <+> docTypeArgument value docTypeExpr (TRef name) = pretty name  docTypeArgument :: TypeExpr -> Doc ann docTypeArgument value@TOptional {} = parens (docTypeExpr value) docTypeArgument value@TList {} = parens (docTypeExpr value) docTypeArgument value@TMap {} = parens (docTypeExpr value)+docTypeArgument value@TKeyedMap {} = parens (docTypeExpr value) docTypeArgument value = docTypeExpr value  docNode :: Node -> Doc ann@@ -343,6 +370,7 @@       WqUnordered -> []       WqFifoThroughput -> [indent 2 "ordering fifo-throughput"]       WqFifoRoundRobin -> [indent 2 "ordering fifo-roundrobin"]+      WqFifoHeads -> [indent 2 "ordering fifo-heads"]     groupKeyLines = case (.groupKey) w of       Nothing -> []       Just groupKey ->@@ -565,6 +593,7 @@       ++ map (indent 2 . docBind) ((.binds) i)       ++ [ indent 2 ("dedupe key" <+> pretty ((.dedupeKey) i) <+> "policy" <+> pretty ((.dedupePolicy) i))          ]+      ++ [indent 2 "idempotence delegated" | (.idempotence) i == IdemDelegated]       ++ [indent 2 "persist = dedupe-only" | (.persist) i == InkPersistDedupeOnly]       ++ [ indent 2 (docDecode ((.decode) i)),            indent 2 "disposition {"@@ -626,6 +655,7 @@         <> ":"         <+> docContractType ((.valueType) f)     docContractType (CTypeId p) = "typeid" <+> dquoted p+    docContractType (CDeclaredId name) = pretty name     docContractType CText = "text"     docContractType CInt = "int" @@ -634,24 +664,118 @@ --------------------------------------------------------------------------------  docProcess :: ProcessNode -> Doc ann-docProcess p =+docProcess p = case (.body) p of+  LegacyProcessBody input handle timer ->+    vsep+      [ "process" <+> pretty ((.id) p),+        indent 2 ("name" <+> dquoted ((.name) p)),+        indent 2 (docInput input),+        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 handle),+        mempty,+        indent 2 "dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)",+        indent 2 ("rejected =>" <+> docPolicyChoice ((.rejected) p)),+        indent 2 ("poison =>" <+> docPolicyChoice ((.poison) p)),+        mempty,+        indent 2 (docTimer timer)+      ]+  ReactionProcessBody reaction ->+    vsep+      ( [ "process" <+> pretty ((.id) p),+          indent 2 ("name" <+> dquoted ((.name) p)),+          indent 2 ("reactions version" <+> pretty ((.version) reaction))+        ]+          ++ map (indent 2 . docInput) (NE.toList ((.inputs) reaction))+          ++ [ 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+             ]+          ++ concatMap (\node -> [indent 2 (docReactionNode node), mempty]) (NE.toList ((.reactions) reaction))+          ++ [ indent 2 "dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, targetStreamName, occurrence)",+               indent 2 ("rejected =>" <+> docPolicyChoice ((.rejected) p)),+               indent 2 ("poison =>" <+> docPolicyChoice ((.poison) p))+             ]+          ++ maybe [] (\policy -> [mempty, indent 2 (docTimerPolicy policy)]) ((.timerPolicy) reaction)+          ++ concatMap (\timer -> [mempty, indent 2 (docReactionTimer timer)]) ((.timers) reaction)+      )++docReactionBody :: ReactionBody -> Doc ann+docReactionBody reaction =   vsep-    [ "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 ((.handle) p)),-      mempty,-      indent 2 "dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)",-      indent 2 ("rejected =>" <+> docPolicyChoice ((.rejected) p)),-      indent 2 ("poison =>" <+> docPolicyChoice ((.poison) p)),-      mempty,-      indent 2 (docTimer ((.timer) p))+    ( ["reactions version" <+> pretty ((.version) reaction)]+        ++ map docInput (NE.toList ((.inputs) reaction))+        ++ concatMap (\node -> [docReactionNode node]) (NE.toList ((.reactions) reaction))+        ++ maybe [] (\policy -> [docTimerPolicy policy]) ((.timerPolicy) reaction)+        ++ map docReactionTimer ((.timers) reaction)+    )++docReactionNode :: ReactionNode -> Doc ann+docReactionNode node =+  vsep+    ( ("on" <+> pretty ((.on) node))+        : map (indent 2 . docReactionArm) (NE.toList ((.arms) node))+    )++docReactionArm :: ReactionArm -> Doc ann+docReactionArm arm = case (.guard) arm of+  UnconditionalArm -> docArmBody ((.body) arm)+  WhenArm expression -> vsep ["when" <+> docExpr 0 expression, indent 2 (docArmBody ((.body) arm))]+  OtherwiseArm -> vsep ["otherwise", indent 2 (docArmBody ((.body) arm))]++docArmBody :: ArmBody -> Doc ann+docArmBody NoAction = "no-action"+docArmBody ArmActions {advance, followUps} =+  vsep (maybe [] docAdvanceReaction advance ++ map docFollowUp followUps)++docAdvanceReaction :: AdvanceReaction -> [Doc ann]+docAdvanceReaction advance =+  ["advance" <+> pretty ((.command) advance) <+> braced (map docFieldBinding ((.fields) advance))]+    ++ case (.accepted) advance of+      Nothing -> []+      Just followUps ->+        [ indent 2 "accepted",+          indent 4 (vsep (map docFollowUp followUps)),+          indent 2 "silent no-action"+        ]++docFollowUp :: FollowUp -> Doc ann+docFollowUp (FollowDispatch dispatch) = docDispatch dispatch+docFollowUp (FollowSchedule schedule) = case (.mode) schedule of+  ScheduleRearm -> scheduleLine mempty+  ScheduleOnce -> scheduleLine "once"+  where+    scheduleLine modeDoc =+      hsep+        ( ["schedule", pretty ((.timer) schedule)]+            ++ [modeDoc | (.mode) schedule == ScheduleOnce]+            ++ ["fireAt", docFireAt ((.fireAt) schedule), braced (map docFieldBinding ((.bindings) schedule))]+        )+docFollowUp (FollowCancel timer _) = "cancel" <+> pretty timer++docTimerPolicy :: TimerPolicy -> Doc ann+docTimerPolicy policy =+  "timers max-attempts" <+> pretty ((.maxAttempts) policy) <+> "dead-letter" <+> dquoted ((.deadLetter) policy)++docReactionTimer :: ReactionTimerNode -> Doc ann+docReactionTimer timer =+  vsep+    [ "timer" <+> pretty ((.name) timer),+      indent 2 ("id" <+> docIdExpr ((.id) timer)),+      indent 2 ("payload" <+> braced (map docPayloadField ((.payload) timer))),+      indent 2 (docFire ((.fire) timer)),+      indent 2 ("decode unknown-status =>" <+> pretty ((.decodeUnknown) timer))     ]++docPayloadField :: PayloadField -> Doc ann+docPayloadField (PayloadConstant name value) = pretty name <> "=" <> dquoted value+docPayloadField (PayloadTyped name valueType) =+  pretty name <> maybe mempty (\typeName -> ":" <> pretty typeName) valueType  docRouter :: RouterNode -> Doc ann docRouter r =
+ src/Keiro/Dsl/ProcessReaction.hs view
@@ -0,0 +1,396 @@+{-# OPTIONS_GHC -Werror=incomplete-patterns #-}++-- | Checked Language 6 process-reaction semantics.+module Keiro.Dsl.ProcessReaction+  ( CheckedProcessReaction (..),+    CheckedReactionArm (..),+    CheckedReactionGuard (..),+    CheckedFollowUp (..),+    CheckedReactionTimer (..),+    ProcessReactionDiagnosticCode (..),+    ProcessReactionDiagnostic (..),+    checkProcessReaction,+    processReactionFingerprint,+    processReactionFingerprintFrom,+  )+where++import Crypto.Hash.SHA256 qualified as SHA256+import Data.ByteString qualified as BS+import Data.List (find, group, sort)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as Text+import Data.Word (Word8)+import Keiro.Dsl.AggregateType+import Keiro.Dsl.CanonicalEncoding (canonicalReactionSurface)+import Keiro.Dsl.Grammar+import Keiro.Dsl.NominalType (NominalRepresentation (..), ResolvedNominalType (..))+import Keiro.Dsl.SemanticContract (EffectiveLanguageContract)+import Keiro.Dsl.TypeGraph (TypeGraph)+import Numeric (showHex)+import Numeric.Natural (Natural)++data CheckedReactionGuard+  = CheckedUnconditional+  | CheckedWhen !Expr+  | CheckedOtherwise+  deriving stock (Eq, Show)++newtype CheckedFollowUp = CheckedFollowUp {syntax :: FollowUp}+  deriving stock (Eq, Show)++data CheckedReactionArm = CheckedReactionArm+  { input :: !Name,+    ordinal :: !Int,+    guard :: !CheckedReactionGuard,+    body :: !ArmBody+  }+  deriving stock (Eq, Show)++newtype CheckedReactionTimer = CheckedReactionTimer {syntax :: ReactionTimerNode}+  deriving stock (Eq, Show)++data CheckedProcessReaction = CheckedProcessReaction+  { version :: !Natural,+    inputs :: !(NonEmpty InputDecl),+    arms :: ![CheckedReactionArm],+    timers :: ![CheckedReactionTimer],+    fingerprint :: !Text,+    verification :: !Text,+    holeObligations :: ![Text]+  }+  deriving stock (Eq, Show)++data ProcessReactionDiagnosticCode+  = ProcessReactionUnknownInput+  | ProcessInputDuplicateDeclaration+  | ProcessTimerDuplicateName+  | ProcessReactionGuardNotBoolean+  | ProcessStateAccessUnsupported+  | ProcessReactionInputUnhandled+  | ProcessReactionDuplicateInput+  | ProcessReactionOtherwiseMissing+  | ProcessReactionOtherwiseUnreachable+  | ProcessTimerPrefixCollision+  | ProcessScheduleUnknownTimer+  | ProcessCancelUnknownTimer+  | ProcessSchedulePayloadIncomplete+  | ProcessTimerPolicyMissing+  | ProcessTimerPolicyUnused+  | ProcessAcceptedArmRequiresEvent+  | ProcessSilentArmMissing+  | ProcessAcceptedArmUnverified+  | ProcessBindingTypeMismatch+  deriving stock (Eq, Ord, Show, Enum, Bounded)++data ProcessReactionDiagnostic = ProcessReactionDiagnostic+  { loc :: !Loc,+    code :: !ProcessReactionDiagnosticCode,+    message :: !Text+  }+  deriving stock (Eq, Show)++checkProcessReaction :: EffectiveLanguageContract -> TypeGraph -> Spec -> ProcessNode -> Either (NonEmpty ProcessReactionDiagnostic) CheckedProcessReaction+checkProcessReaction _languageContract graph spec process = case (.body) process of+  LegacyProcessBody {} -> failure ((.loc) process) ProcessReactionUnknownInput "legacy process has no checked reaction body"+  ReactionProcessBody reaction -> do+    let symbols = aggregateSymbolsFromGraph graph spec+        inputList = NE.toList ((.inputs) reaction)+        inputNames = map (.name) inputList+        reactionList = NE.toList ((.reactions) reaction)+        reactionNames = map (.on) reactionList+        timerList = (.timers) reaction+        timerNames = map (.name) timerList+    requireNoDuplicate ProcessInputDuplicateDeclaration "input" ((.loc) process) inputNames+    requireNoDuplicate ProcessTimerDuplicateName "timer" ((.loc) process) timerNames+    requireNoDuplicate ProcessReactionDuplicateInput "on block" ((.loc) process) reactionNames+    case [node | node <- reactionList, (.on) node `notElem` inputNames] of+      node : _ -> failure ((.loc) node) ProcessReactionUnknownInput ("reaction names undeclared input '" <> (.on) node <> "'")+      [] -> pure ()+    case [input | input <- inputList, (.name) input `notElem` reactionNames] of+      input : _ -> failure ((.loc) input) ProcessReactionInputUnhandled ("input '" <> (.name) input <> "' has no on block")+      [] -> pure ()+    checkTimerPolicy reaction+    checkPrefixCollisions timerList+    checkedArms <- concat <$> traverse (checkReaction symbols inputList timerList) reactionList+    traverse_ (checkTimer symbols) timerList+    let holes =+          [ (.agg) ((.saga) process) <> "." <> (.command) advance <> " accepted-event proof"+          | arm <- checkedArms,+            ArmActions {advance = Just advance} <- [(.body) arm],+            Just _ <- [(.accepted) advance],+            armUnverified arm+          ]+        initial =+          CheckedProcessReaction+            { version = (.version) reaction,+              inputs = (.inputs) reaction,+              arms = checkedArms,+              timers = map CheckedReactionTimer timerList,+              fingerprint = "",+              verification = if null holes then "generated-declarative" else "custom-unverified",+              holeObligations = holes+            }+    pure initial {fingerprint = processReactionFingerprintFrom reaction}+  where+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]++    checkReaction symbols inputList timerList reactionNode = do+      input <- case find ((== (.on) reactionNode) . (.name)) inputList of+        Nothing -> failure ((.loc) reactionNode) ProcessReactionUnknownInput "reaction input is undeclared"+        Just value -> Right value+      checkTotality reactionNode+      traverse (checkArm symbols input timerList) (zip [0 ..] (NE.toList ((.arms) reactionNode)))++    checkTotality reactionNode = do+      let armList = NE.toList ((.arms) reactionNode)+          guards = map (.guard) armList+          otherwiseIndexes = [index | (index, OtherwiseArm) <- zip [0 ..] guards]+      case otherwiseIndexes of+        index : _ | index /= length guards - 1 -> failure ((.loc) (armList !! index)) ProcessReactionOtherwiseUnreachable "otherwise must be the final arm"+        _ -> pure ()+      if any isWhen guards && null otherwiseIndexes+        then failure ((.loc) reactionNode) ProcessReactionOtherwiseMissing "guarded reactions must end in otherwise"+        else pure ()+      where+        isWhen WhenArm {} = True+        isWhen _ = False++    checkArm symbols input timerList (ordinal, arm) = do+      checkedGuard <- case (.guard) arm of+        UnconditionalArm -> Right CheckedUnconditional+        OtherwiseArm -> Right CheckedOtherwise+        WhenArm expression -> checkGuard symbols input expression >> Right (CheckedWhen expression)+      checkArmBody symbols input timerList ((.body) arm)+      pure CheckedReactionArm {input = (.name) input, ordinal, guard = checkedGuard, body = (.body) arm}++    checkArmBody _ _ _ NoAction = Right ()+    checkArmBody symbols input timerList ArmActions {advance, followUps} = do+      maybe (pure ()) (checkAdvance symbols input) advance+      traverse_ (checkFollowUp symbols input timerList) followUps+      case advance >>= (.accepted) of+        Nothing -> pure ()+        Just acceptedFollowUps -> traverse_ (checkFollowUp symbols input timerList) acceptedFollowUps++    checkAdvance symbols input advance = do+      sagaAggregate <- requireAggregate ((.loc) advance) ((.agg) ((.saga) process))+      command <- requireCommand ((.loc) advance) sagaAggregate ((.command) advance)+      checkBindings symbols input sagaAggregate command ((.loc) advance) ((.fields) advance)+      case (.accepted) advance of+        Nothing -> pure ()+        Just _ -> do+          if (.silentNoAction) advance+            then pure ()+            else failure ((.loc) advance) ProcessSilentArmMissing "accepted follow-ups require silent no-action"+          let matching = [transition | transition <- (.transitions) sagaAggregate, (.command) transition == (.command) advance, (.mode) transition == TmLive]+          case [transition | transition <- matching, (.implementation) transition == HoleImplementation] of+            _ : _ -> failure ((.loc) advance) ProcessAcceptedArmUnverified "accepted follow-ups cannot be verified for a hole-owned saga transition"+            [] -> pure ()+          case [transition | transition <- matching, accepts transition && null ((.emits) transition)] of+            _ : _ -> failure ((.loc) advance) ProcessAcceptedArmRequiresEvent "every accepting saga transition must emit an event before it can guard accepted follow-ups"+            [] -> pure ()++    accepts transition = case (.outcome) transition of+      Just OutcomeRejected {} -> False+      Just OutcomeNoOp {} -> False+      Just OutcomeAccepted {} -> True+      Nothing -> True++    checkFollowUp symbols input timerList = \case+      FollowDispatch dispatch -> do+        aggregate <- requireAggregate ((.loc) dispatch) ((.target) dispatch)+        command <- requireCommand ((.loc) dispatch) aggregate ((.command) dispatch)+        checkBindings symbols input aggregate command ((.loc) dispatch) ((.fields) dispatch)+      FollowSchedule schedule -> case find ((== (.timer) schedule) . (.name)) timerList of+        Nothing -> failure ((.loc) schedule) ProcessScheduleUnknownTimer ("schedule names undeclared timer '" <> (.timer) schedule <> "'")+        Just timer -> do+          checkSchedulePayload symbols input timer schedule+          requireInputType symbols input ((.loc) schedule) ((.field) ((.fireAt) schedule)) >>= requireExactType ((.loc) schedule) AggregateTime+      FollowCancel timerName loc ->+        if timerName `elem` map (.name) timerList+          then Right ()+          else failure loc ProcessCancelUnknownTimer ("cancel names undeclared timer '" <> timerName <> "'")++    checkSchedulePayload symbols input timer schedule = do+      let required = [name | PayloadTyped name _ <- (.payload) timer]+          actual = map (.name) ((.bindings) schedule)+      case [name | name <- required, name `notElem` actual] of+        name : _ -> failure ((.loc) schedule) ProcessSchedulePayloadIncomplete ("schedule omits typed payload field '" <> name <> "'")+        [] -> pure ()+      traverse_ (checkPayloadBinding symbols input timer) ((.bindings) schedule)++    checkPayloadBinding symbols input timer binding = case find ((== (.name) binding) . payloadName) ((.payload) timer) of+      Nothing -> pure ()+      Just PayloadConstant {} -> pure ()+      Just (PayloadTyped _ maybeType) -> do+        actual <- bindingType symbols input ((.loc) timer) binding+        expected <- resolveType symbols ((.loc) timer) (maybe TText nameTypeExpr maybeType)+        requireSame ((.loc) timer) expected actual++    checkTimer symbols timer = do+      aggregate <- requireAggregate ((.loc) timer) ((.target) ((.fire) timer))+      command <- requireCommand ((.loc) timer) aggregate ((.command) ((.fire) timer))+      checkTimerFireBindings symbols timer aggregate command++    checkTimerFireBindings symbols timer aggregate command =+      traverse_ (checkOne command) ((.fields) ((.fire) timer))+      where+        checkOne commandDecl binding = case find ((== (.name) binding) . (.name)) ((.fields) commandDecl) of+          Nothing -> pure ()+          Just field -> do+            expected <- mapType ((.loc) timer) (inferAggregateFieldType symbols aggregate CommandFieldUse field)+            actual <- case (.value) binding of+              Just "timer.id" -> Right AggregateText+              _ -> case find ((== (.name) binding) . payloadName) ((.payload) timer) of+                Just (PayloadTyped _ maybeType) -> resolveType symbols ((.loc) timer) (maybe TText nameTypeExpr maybeType)+                Just PayloadConstant {} -> Right AggregateText+                Nothing -> Right AggregateText+            requireSame ((.loc) timer) expected actual++    checkBindings symbols input aggregate command loc bindings =+      traverse_ checkOne bindings+      where+        checkOne binding = case find ((== (.name) binding) . (.name)) ((.fields) command) of+          Nothing -> pure ()+          Just field -> do+            expected <- mapType loc (inferAggregateFieldType symbols aggregate CommandFieldUse field)+            actual <- bindingType symbols input loc binding+            requireSame loc expected actual++    checkGuard symbols input expression = do+      valueType <- guardType symbols input expression+      requireExactType (exprLoc expression) AggregateBool valueType++    guardType symbols input = \case+      EAnd left right -> booleanPair left right+      EOr left right -> booleanPair left right+      ECmp operator left right -> do+        leftType <- guardType symbols input left+        rightType <- guardType symbols input right+        requireSame (exprLoc left) leftType rightType+        if operator `elem` [OpLt, OpLe, OpGt, OpGe] && leftType `notElem` [AggregateText, AggregateInt, AggregateInteger, AggregateNatural, AggregateTime]+          then failure (exprLoc left) ProcessReactionGuardNotBoolean "ordering comparison requires Text, a number, or Time"+          else Right AggregateBool+      EPath loc UnqualifiedRoot ["input", field] -> requireInputType symbols input loc field+      EPath loc _ _ -> failure loc ProcessStateAccessUnsupported "reaction guards may read only input.<field>; saga/register/command state is unsupported"+      ELiteral _ (LiteralBool _) -> Right AggregateBool+      ELiteral _ (LiteralText _) -> Right AggregateText+      ELiteral _ (LiteralIntegral _) -> Right AggregateInteger+      ELiteral loc (LiteralQualified typeName constructor) -> do+        resolved <- resolveType symbols loc (TRef typeName)+        case resolved of+          AggregateNominal nominal -> case (.representation) nominal of+            EnumRepresentation constructors | constructor `elem` map fst (NE.toList constructors) -> Right resolved+            _ -> failure loc ProcessReactionGuardNotBoolean "qualified literal is not a constructor of the declared enum"+          _ -> failure loc ProcessReactionGuardNotBoolean "qualified literal must name a declared enum"+      ELiteral loc LiteralId {} -> failure loc ProcessReactionGuardNotBoolean "id constructor literals are not supported in reaction guards"+      EAdd loc _ _ -> failure loc ProcessReactionGuardNotBoolean "arithmetic is not supported in reaction guards"+      ESubtract loc _ _ -> failure loc ProcessReactionGuardNotBoolean "arithmetic is not supported in reaction guards"+      EMultiply loc _ _ -> failure loc ProcessReactionGuardNotBoolean "arithmetic is not supported in reaction guards"+      EAtom (ABool _) -> Right AggregateBool+      EAtom (AName _) -> failure noLoc ProcessStateAccessUnsupported "bare names are not supported in reaction guards; use input.<field>"+      where+        booleanPair left right = do+          leftType <- guardType symbols input left+          rightType <- guardType symbols input right+          requireExactType (exprLoc left) AggregateBool leftType+          requireExactType (exprLoc right) AggregateBool rightType+          Right AggregateBool++    requireInputType symbols input loc field = case find ((== field) . (.name)) ((.fields) input) of+      Nothing -> failure loc ProcessStateAccessUnsupported ("input '" <> (.name) input <> "' has no field '" <> field <> "'")+      Just declaration -> resolveType symbols loc (maybe TText nameTypeExpr ((.valueType) declaration))++    bindingType symbols input loc binding = case (.value) binding of+      Nothing -> requireInputType symbols input loc ((.name) binding)+      Just value+        | isQuoted value -> Right AggregateText+        | Just field <- T.stripPrefix "input." value -> requireInputType symbols input loc field+        | value == "timer.id" -> Right AggregateText+        | otherwise -> requireInputType symbols input loc value++    requireAggregate loc name = case [aggregate | aggregate <- aggregates, (.name) aggregate == name] of+      aggregate : _ -> Right aggregate+      [] -> failure loc ProcessBindingTypeMismatch ("aggregate '" <> name <> "' is unavailable for reaction type checking")++    requireCommand loc aggregate name = case [command | command <- (.commands) aggregate, (.name) command == name] of+      command : _ -> Right command+      [] -> failure loc ProcessBindingTypeMismatch ("aggregate '" <> (.name) aggregate <> "' has no command '" <> name <> "'")++    resolveType symbols loc expression = mapType loc (resolveAggregateType symbols loc CommandFieldUse expression)+    mapType loc = either (const (failure loc ProcessBindingTypeMismatch "type is not supported by process reactions")) Right+    requireSame loc expected actual+      | expected == actual = Right ()+      | otherwise = failure loc ProcessBindingTypeMismatch ("binding type mismatch: expected " <> aggregateCanonicalName expected <> ", got " <> aggregateCanonicalName actual)+    requireExactType loc expected actual+      | expected == actual = Right ()+      | otherwise = failure loc ProcessReactionGuardNotBoolean "reaction guard must have Boolean type"+    isQuoted value = T.length value >= 2 && T.head value == '"' && T.last value == '"'+    nameTypeExpr = \case+      "Text" -> TText+      "Int" -> TInt+      "Integer" -> TInteger+      "Bool" -> TBool+      "Natural" -> TNatural+      "Time" -> TTime+      name -> TRef name+    payloadName (PayloadConstant name _) = name+    payloadName (PayloadTyped name _) = name+    armUnverified arm = case (.body) arm of+      ArmActions {advance = Just advance} -> case (.accepted) advance of+        Just _ -> any (\aggregate -> (.agg) ((.saga) process) == (.name) aggregate && any (\transition -> (.command) transition == (.command) advance && (.implementation) transition == HoleImplementation) ((.transitions) aggregate)) aggregates+        Nothing -> False+      _ -> False++checkTimerPolicy :: ReactionBody -> Either (NonEmpty ProcessReactionDiagnostic) ()+checkTimerPolicy reaction = case ((.timerPolicy) reaction, (.timers) reaction) of+  (Nothing, _ : _) -> failure ((.versionLoc) reaction) ProcessTimerPolicyMissing "a process with timers requires a timers policy"+  (Just policy, []) -> failure ((.loc) policy) ProcessTimerPolicyUnused "a timer-free process must not declare a timers policy"+  _ -> Right ()++checkPrefixCollisions :: [ReactionTimerNode] -> Either (NonEmpty ProcessReactionDiagnostic) ()+checkPrefixCollisions timers =+  case duplicates (map ((.prefix) . (.id)) timers <> map ((.prefix) . (.firedEventId) . (.fire)) timers) of+    prefix : _ ->+      failure+        (maybe noLoc (.loc) (find (ownsPrefix prefix) timers))+        ProcessTimerPrefixCollision+        ("timer identity prefix is reused: " <> prefix)+    [] -> Right ()+  where+    ownsPrefix prefix timer = (.prefix) ((.id) timer) == prefix || (.prefix) ((.firedEventId) ((.fire) timer)) == prefix++processReactionFingerprint :: CheckedProcessReaction -> Text+processReactionFingerprint = (.fingerprint)++processReactionFingerprintFrom :: ReactionBody -> Text+processReactionFingerprintFrom reaction = hex (BS.unpack (SHA256.hash (Text.encodeUtf8 canonical)))+  where+    canonical = canonicalReactionSurface reaction++hex :: (Foldable f) => f Word8 -> Text+hex = T.pack . concatMap twoHex . foldr (:) []+  where+    twoHex byte = case showHex byte "" of+      [digit] -> ['0', digit]+      digits -> digits++failure :: Loc -> ProcessReactionDiagnosticCode -> Text -> Either (NonEmpty ProcessReactionDiagnostic) a+failure loc code message = Left (ProcessReactionDiagnostic loc code message :| [])++requireNoDuplicate :: ProcessReactionDiagnosticCode -> Text -> Loc -> [Name] -> Either (NonEmpty ProcessReactionDiagnostic) ()+requireNoDuplicate code label loc names = case duplicates names of+  name : _ -> failure loc code (label <> " '" <> name <> "' is declared more than once")+  [] -> Right ()++duplicates :: (Ord a) => [a] -> [a]+duplicates = foldr collect [] . group . sort+  where+    collect (value : _ : _) rest = value : rest+    collect _ rest = rest++traverse_ :: (Applicative f) => (a -> f b) -> [a] -> f ()+traverse_ action = foldr (\value rest -> action value *> rest) (pure ())
src/Keiro/Dsl/ProjectionMappedImpact.hs view
@@ -160,10 +160,10 @@     base = "aggregate:" <> aggregate <> "/generated-codec/v1"     eventRows graph =       sort-        [ renderUsePath (UsePath site (useSiteSegments graph site))+        [ renderUsePath (UsePath ((.root) site) (useSiteSegments graph site <> [SegDecl (unMappedKey declarationKey)]))             <> "|wire="             <> wireFingerprint graph (unMappedKey declarationKey)-        | site@(RootEventField authority _ _ declarationKey) <- (.useSites) graph,+        | site@UseSite {root = RootEventField authority _ _, mappedKey = declarationKey} <- (.useSites) graph,           authority == aggregate         ] @@ -274,7 +274,7 @@     ]  eventAuthority :: UsePath -> Maybe Name-eventAuthority UsePath {root = RootEventField aggregate _ _ _} = Just aggregate+eventAuthority UsePath {root = RootEventField aggregate _ _} = Just aggregate eventAuthority _ = Nothing  derivedAuthority :: DerivedMappedConsumer -> Name
src/Keiro/Dsl/ReadModelQueryContract.hs view
@@ -139,7 +139,9 @@         onOptional = id,         onList = id,         onMap = id,-        onRef = \key -> Set.insert key (Map.findWithDefault Set.empty key ((.reachability) graph))+        onKeyedMap = \_ -> id,+        onRef = \key -> Set.insert key (Map.findWithDefault Set.empty key ((.reachability) graph)),+        onNominal = const Set.empty       }  positionLabel :: QueryContractPosition -> Text
src/Keiro/Dsl/ReplayImpact.hs view
@@ -39,6 +39,15 @@ import Keiro.Dsl.ProjectionMappedImpact qualified as ProjectionImpact import Keiro.Dsl.SemanticContract (CheckedService, checkedSpec, checkedTypeGraph) import Keiro.Dsl.SemanticImpact (semanticImpact)+import Keiro.Dsl.TransitionFamily+  ( ReplayBodyDelta (..),+    ReplayBodyStatus (..),+    TransitionFamilyDelta (..),+    TransitionFamilyKey (..),+    guardImplies,+    replayBodyDeltas,+    transitionFamilyDeltas,+  ) import Keiro.Dsl.TypeGraph (BindingVersion (..), CanonicalTypeId (..), DerivedMappedConsumer (..), MappedKey (..), QualifiedValueName (..), TypeGraph (..), TypeGraphError, wireFingerprint)  -- | The smallest conservative audit input for one aggregate.@@ -348,16 +357,49 @@ changedTransitionEvents :: [Transition] -> [Transition] -> (Set Name, Bool) changedTransitionEvents oldTransitions newTransitions =   foldl'-    (\(affected, changed) key -> let (groupAffected, groupChanged) = compareGroup key in (affected <> groupAffected, changed || groupChanged))+    combine     (Set.empty, False)-    (Set.toAscList allKeys)+    (liveBodyImpacts <> nonBodyImpacts)   where-    oldGroups = transitionGroups oldTransitions-    newGroups = transitionGroups newTransitions-    allKeys = Map.keysSet oldGroups <> Map.keysSet newGroups-    compareGroup key =-      let (afterExactOld, afterExactNew) = cancelExact (Map.findWithDefault [] key oldGroups) (Map.findWithDefault [] key newGroups)-          (remainingOld, remainingNew) = cancelLoosenings afterExactOld afterExactNew+    combine (affected, changed) (groupAffected, groupChanged) =+      (affected <> groupAffected, changed || groupChanged)++    liveBodyImpacts = map compareLiveBodies (Map.elems liveBodyGroups)+    liveBodyGroups =+      Map.fromListWith+        (flip (<>))+        [ ((.bodyFamilyKey) bodyDelta, [bodyDelta])+        | bodyDelta <- replayBodyDeltas oldTransitions newTransitions,+          (.familyMode) ((.bodyFamilyKey) bodyDelta) == TmLive+        ]++    compareLiveBodies bodyDeltas+      | any bodyCanChangeReplay bodyDeltas =+          ( Set.unions+              [ emittedBy transition+              | bodyDelta <- bodyDeltas,+                transition <- (.oldBodyMembers) bodyDelta <> (.newBodyMembers) bodyDelta+              ],+            True+          )+      | otherwise = (Set.empty, False)++    bodyCanChangeReplay bodyDelta =+      (.bodyStatus) bodyDelta `elem` [ReplayBodyChanged, ReplayBodyRemoved]+        || any ((== HoleImplementation) . (.implementation)) ((.oldBodyMembers) bodyDelta)++    nonBodyImpacts =+      [ compareRemainder oldRelevant newRelevant+      | delta <- transitionFamilyDeltas oldTransitions newTransitions,+        let mode = (.familyMode) ((.familyKey) delta),+        let select = if mode == TmReplayOnly then const True else null . (.emits),+        let oldRelevant = filter select ((.oldRemainder) delta),+        let newRelevant = filter select ((.newRemainder) delta),+        not (null oldRelevant && null newRelevant)+      ]++    compareRemainder oldRemainder newRemainder =+      let (remainingOld, remainingNew) = cancelLoosenings oldRemainder newRemainder           sortedOld = sortOn transitionSortKey remainingOld           sortedNew = sortOn transitionSortKey remainingNew           (pairedOld, unpairedOld) = splitAt (length sortedNew) sortedOld@@ -367,35 +409,10 @@           changed = not (null pairedOld) || not (null unpairedOld)        in (pairedEvents <> removedEvents, changed) -    transitionGroups =-      Map.fromListWith (<>)-        . map (\transition -> (transitionIdentity transition, [transition]))-    transitionIdentity transition =-      ( modeKey ((.mode) transition),-        (.source) transition,-        (.command) transition-      )-    modeKey TmLive = "live" :: Text-    modeKey TmReplayOnly = "replay-only"     transitionSortKey transition =       (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.-cancelExact :: [Transition] -> [Transition] -> ([Transition], [Transition])-cancelExact oldTransitions newTransitions = go sortedOld sortedNew [] []-  where-    sortedOld = sortOn canonicalTransition oldTransitions-    sortedNew = sortOn canonicalTransition newTransitions-    go [] remainingNew unmatchedOld unmatchedNew = (reverse unmatchedOld, reverse unmatchedNew <> remainingNew)-    go remainingOld [] unmatchedOld unmatchedNew = (reverse unmatchedOld <> remainingOld, reverse unmatchedNew)-    go old@(oldTransition : remainingOld) new@(newTransition : remainingNew) unmatchedOld unmatchedNew =-      case compare (canonicalTransition oldTransition) (canonicalTransition newTransition) of-        LT -> go remainingOld new (oldTransition : unmatchedOld) unmatchedNew-        EQ -> go remainingOld remainingNew unmatchedOld unmatchedNew-        GT -> go old remainingNew unmatchedOld (newTransition : unmatchedNew)- -- | Deterministically cancel every provable guard-only loosening. At each step -- the lexicographically smallest canonical pair wins, so ambiguous siblings do -- not inherit declaration-order semantics.@@ -461,19 +478,6 @@       mode = transition.mode,       loc = transition.loc     }--guardImplies :: Maybe Expr -> Maybe Expr -> Bool-guardImplies _ Nothing = True-guardImplies Nothing (Just _) = False-guardImplies (Just oldGuard) (Just newGuard) = implies oldGuard newGuard-  where-    implies old new-      | old == new = True-    implies (EAtom (ABool False)) _ = True-    implies _ (EAtom (ABool True)) = True-    implies (EAnd left right) new = implies left new || implies right new-    implies old (EOr left right) = implies old left || implies old right-    implies _ _ = False  renderReplayImpact :: ReplayImpact -> Text renderReplayImpact ReplayNeutral =
src/Keiro/Dsl/RouterSelection.hs view
@@ -39,10 +39,12 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as Text+import Data.TypeID qualified as TypeID import GHC.Generics (Generic) import Keiro.Dsl.AggregateType import Keiro.Dsl.Grammar import Keiro.Dsl.LanguageVersion (LanguageFeature (DeclarativeRouterSelectionSyntax), languageSupportsFeature)+import Keiro.Dsl.NominalType (NominalRepresentation (..), ResolvedNominalType (..)) import Keiro.Dsl.SemanticContract (EffectiveLanguageContract (..)) import Keiro.Dsl.TypeGraph import Numeric (showHex)@@ -75,7 +77,8 @@   | SelectionBool   | SelectionNatural   | SelectionTime-  deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)+  | SelectionNominal !Name+  deriving stock (Eq, Ord, Show, Generic)  data SelectionRoot = SelectionInput | SelectionRow   deriving stock (Eq, Ord, Show, Generic)@@ -99,6 +102,7 @@   | CheckedTextLiteral !Text   | CheckedIntegralLiteral !Integer   | CheckedBoolLiteral !Bool+  | CheckedIdLiteral !Name !Text   | CheckedCompare !CmpOp !CheckedScalarExpr !CheckedScalarExpr   | CheckedAnd !CheckedScalarExpr !CheckedScalarExpr   | CheckedOr !CheckedScalarExpr !CheckedScalarExpr@@ -215,11 +219,11 @@       partial <- requireExact ((.partialLoc) declaration) SelectionPartialDispatchUnsupported "partial" "retain-successes" CheckedRetainSuccesses ((.partial) declaration)       (query, inputBinding, rowBinding) <- checkQuery declaration       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+      requireTextOrNominalId ((.loc) ((.input) router)) SelectionQueryInputBindingInvalid "router key" 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+      requireTextOrNominalId (exprLoc ((.recipient) declaration)) SelectionRecipientNotText "recipient expression" recipient       (targetAggregate, targetCommand) <- resolveTargetCommand       commandFields <- checkCommandMappings graph inputBinding rowBinding targetAggregate targetCommand       let initial =@@ -356,9 +360,9 @@     queryUseSites queryName =       [ useSite       | useSite <- (.useSites) graph,-        case useSite of-          RootReadModelQueryInput name _ -> name == queryName-          RootReadModelQueryResult name _ -> name == queryName+        case (.root) useSite of+          RootReadModelQueryInput name -> name == queryName+          RootReadModelQueryResult name -> name == queryName           _ -> False       ] @@ -403,7 +407,7 @@     _ -> selectionFailure loc SelectionExpressionTypeMismatch "integral selection literal needs an Int, Integer, or Natural operand"   ELiteral loc (LiteralBool value) -> literal loc SelectionBool (CheckedBoolLiteral value)   ELiteral loc LiteralQualified {} -> selectionFailure loc SelectionOperatorUnsupported "qualified enum literals are not admitted in declarative router selection"-  ELiteral loc LiteralId {} -> selectionFailure loc SelectionOperatorUnsupported "nominal ID literals are not admitted in declarative router selection"+  ELiteral loc (LiteralId typeName value) -> resolveIdLiteral loc typeName value   EAtom (ABool value) -> literal noLoc SelectionBool (CheckedBoolLiteral value)   EAtom (AName name) -> selectionFailure noLoc SelectionExpressionRootUnknown ("selection expression root must be input or row, found '" <> name <> "'")   EAnd left right -> booleanNode CheckedAnd left right@@ -426,7 +430,7 @@      comparisonNode operator left right = do       (checkedLeft, checkedRight) <- case left of-        ELiteral _ LiteralIntegral {} -> do+        ELiteral _ literalSyntax | contextualLiteral literalSyntax -> do           rightValue <- resolveSelectionExpr graph inputType rowType Nothing right           leftValue <- resolveSelectionExpr graph inputType rowType (Just ((.valueType) rightValue)) left           pure (leftValue, rightValue)@@ -445,6 +449,20 @@      unsupportedArithmetic loc = selectionFailure loc SelectionOperatorUnsupported "arithmetic operators are not admitted in declarative router selection" +    contextualLiteral = \case+      LiteralIntegral {} -> True+      LiteralId {} -> True+      _ -> False++    resolveIdLiteral loc typeName value = case Map.lookup typeName ((.nominalLeaves) graph) of+      Just NominalLeaf {kind = NominalIdLeaf prefix} -> case TypeID.parseText value of+        Left parseError -> selectionFailure loc SelectionExpressionTypeMismatch ("invalid " <> typeName <> " literal: " <> T.pack (show parseError))+        Right parsed+          | TypeID.getPrefix parsed /= prefix -> selectionFailure loc SelectionExpressionTypeMismatch ("ID literal prefix must be '" <> prefix <> "'")+          | otherwise -> literal loc (SelectionNominal typeName) (CheckedIdLiteral typeName value)+      Just _ -> selectionFailure loc SelectionExpressionTypeMismatch ("selection ID literal type '" <> typeName <> "' is not a declared ID")+      Nothing -> selectionFailure loc SelectionExpressionTypeMismatch ("unknown selection ID literal type '" <> typeName <> "'")+ resolvePath :: TypeGraph -> Loc -> ResolvedTypeExpr -> [Name] -> Either (NonEmpty RouterSelectionDiagnostic) (SelectionScalarType, [CheckedSelectionPathSegment]) resolvePath graph diagnosticLoc = go []   where@@ -484,6 +502,12 @@   | (.valueType) expression == expected = Right ()   | otherwise = selectionFailure diagnosticLoc diagnosticCode (owner <> " must have type " <> scalarTypeText expected <> ", found " <> scalarTypeText ((.valueType) expression)) +requireTextOrNominalId :: Loc -> RouterSelectionDiagnosticCode -> Text -> CheckedScalarExpr -> Either (NonEmpty RouterSelectionDiagnostic) ()+requireTextOrNominalId diagnosticLoc diagnosticCode owner expression = case (.valueType) expression of+  SelectionText -> Right ()+  SelectionNominal {} -> Right ()+  actual -> selectionFailure diagnosticLoc diagnosticCode (owner <> " must have type Text or a declared ID, found " <> scalarTypeText actual)+ 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 @@ -499,7 +523,10 @@   ROptional {} -> Nothing   RList {} -> Nothing   RMap {} -> Nothing+  RKeyedMap {} -> Nothing   RRef {} -> Nothing+  RNominal leaf@NominalLeaf {kind = NominalIdLeaf {}} -> Just (SelectionNominal ((.name) leaf))+  RNominal {} -> Nothing  selectionTypeFromAggregate :: ResolvedAggregateType -> Maybe SelectionScalarType selectionTypeFromAggregate = \case@@ -509,7 +536,9 @@   AggregateBool -> Just SelectionBool   AggregateTime -> Just SelectionTime   AggregateNatural -> Just SelectionNatural-  AggregateNominal {} -> Nothing+  AggregateNominal nominal -> case (.representation) nominal of+    IdRepresentation {} -> Just (SelectionNominal ((.name) nominal))+    _ -> Nothing   AggregateVertex {} -> Nothing   AggregateMapped {} -> Nothing @@ -532,6 +561,7 @@   SelectionBool -> "Bool"   SelectionNatural -> "Natural"   SelectionTime -> "Time"+  SelectionNominal name -> name  selectionFailure :: Loc -> RouterSelectionDiagnosticCode -> Text -> Either (NonEmpty RouterSelectionDiagnostic) value selectionFailure diagnosticLoc diagnosticCode diagnosticMessage = Left (RouterSelectionDiagnostic diagnosticLoc diagnosticCode diagnosticMessage :| [])@@ -575,6 +605,7 @@       CheckedTextLiteral value -> tuple [atom "text", atom value]       CheckedIntegralLiteral value -> tuple [atom "integral", atom (T.pack (show value))]       CheckedBoolLiteral value -> tuple [atom "bool", atom (if value then "true" else "false")]+      CheckedIdLiteral name value -> tuple [atom "id", atom name, atom value]       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]@@ -592,7 +623,9 @@   ROptional value -> tuple [atom "Optional", canonicalResolvedType value]   RList value -> tuple [atom "List", canonicalResolvedType value]   RMap value -> tuple [atom "Map", canonicalResolvedType value]+  RKeyedMap key value -> tuple [atom "KeyedMap", atom ((.name) key), canonicalResolvedType value]   RRef key -> tuple [atom "Ref", atom (unMappedKey key)]+  RNominal leaf -> tuple [atom "Nominal", atom ((.name) leaf)]  tuple :: [Text] -> Text tuple values = "[" <> T.concat values <> "]"
src/Keiro/Dsl/Scaffold.hs view
@@ -106,6620 +106,7984 @@ 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+import Data.List (find, findIndex, 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.ProcessReaction (processReactionFingerprintFrom)+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+      <> structuralNominalLeafOwners ctx service graph+      <> 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,+        onKeyedMap = \_ -> BranchMap,+        onRef = \key -> maybe BranchScalar (branchSchemaFor graph) (Map.lookup key ((.declarations) graph)),+        onNominal = const BranchScalar+      }++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"++structuralNominalLeavesModule :: Context -> Text+structuralNominalLeavesModule ctx = structuralPrefix ctx <> ".NominalLeaves"++nominalLeafCodecImport :: Context -> Set.Set Name -> Text+nominalLeafCodecImport ctx names =+  "import "+    <> structuralNominalLeavesModule ctx+    <> " ("+    <> T.intercalate+      ", "+      [ functionName <> name <> "Leaf"+      | name <- Set.toAscList names,+        functionName <- ["encode", "parse"]+      ]+    <> ")"++nominalLeafKeyCodecImport :: Context -> Set.Set Name -> Text+nominalLeafKeyCodecImport ctx names =+  "import "+    <> structuralNominalLeavesModule ctx+    <> " ("+    <> T.intercalate+      ", "+      [ functionName <> name <> "LeafKey"+      | name <- Set.toAscList names,+        functionName <- ["parse", "render"]+      ]+    <> ")"++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++-- | One context-level admission authority for every nominal leaf used by a+-- structural codec, a direct workqueue codec, or a declared-ID contract field. Read-model query aliases need+-- only the domain type import and therefore do not cause this JSON helper to be+-- emitted on their own.+structuralNominalLeafOwners :: Context -> CheckedService -> TypeGraph -> [(ScaffoldModule, [Name])]+structuralNominalLeafOwners ctx service graph =+  [ ( ScaffoldModule+        { path = T.unpack (T.replace "." "/" moduleName <> ".hs"),+          text = emitStructuralNominalLeaves ctx keyedNames leaves,+          kind = Generated,+          origin = "context " <> (.context) spec <> " structural nominal leaves"+        },+      []+    )+  | not (null leaves)+  ]+  where+    spec = checkedSpec service+    moduleName = structuralNominalLeavesModule ctx+    structuralNames = Set.unions (Map.elems ((.nominalReachability) graph))+    queueNames =+      Set.fromList+        [ (.nominal) site+        | site <- (.nominalRootSites) graph,+          RootWorkqueueField {} <- [(.root) site]+        ]+    contractNames =+      Set.fromList+        [ (.nominal) site+        | site <- (.nominalRootSites) graph,+          RootContractField {} <- [(.root) site]+        ]+    leaves =+      [ leaf+      | name <- Set.toAscList (structuralNames <> queueNames <> contractNames),+        Just leaf <- [Map.lookup name ((.nominalLeaves) graph)]+      ]+    keyedNames =+      Set.unions+        [ keyedMapNominalNames expression+        | ResolvedStructural _ shape <- Map.elems ((.declarations) graph),+          expression <- shapeExpressions shape+        ]+    shapeExpressions (RRecord _ _ fields) = map (.valueType) fields+    shapeExpressions (RUnion _ arms) = [payload | arm <- arms, payload <- maybe [] pure ((.payload) arm)]+    shapeExpressions REnum {} = []++emitStructuralNominalLeaves :: Context -> Set.Set Name -> [NominalLeaf] -> Text+emitStructuralNominalLeaves ctx keyedNames leaves =+  nl $+    renderGeneratedLanguagePragmas []+      <> [ generatedBanner,+           "module " <> moduleName <> " where",+           ""+         ]+      <> imports+      <> ["", T.intercalate "\n\n" (map emitLeaf leaves)]+  where+    moduleName = structuralNominalLeavesModule ctx+    importPlan =+      planImportsOrDie+        moduleName+        ( Set.fromList+            [ functionName <> name <> "Leaf"+            | leaf <- leaves,+              name <- [(.name) leaf],+              functionName <- ["encode", "parse"]+            ]+            <> Set.fromList+              [ functionName <> (.name) leaf <> "LeafKey"+              | leaf <- leaves,+                Set.member ((.name) leaf) keyedNames,+                NominalIdLeaf {} <- [(.kind) leaf],+                functionName <- ["parse", "render"]+              ]+        )+        (Set.fromList (concatMap leafReferences leaves))+    imports =+      [ "import Data.Aeson (" <> T.intercalate ", " aesonImports <> ")",+        "import Data.Aeson.Types (Parser)"+      ]+        <> ["import Data.KindID qualified as KindID" | any isConsumerId leaves]+        <> ["import Data.Text (Text)" | not (Set.null keyedNames)]+        <> ["import Data.Text qualified as T" | any isGeneratedId leaves]+        <> ["import Keiro.Codec.IdDomain (parseKindIdV7Text)" | any isConsumerId leaves]+        <> ["import Keiro.Codec.Nominal (nominalFromRepresentation, nominalToRepresentation)" | any isConsumer leaves]+        <> T.lines (renderPlannedImports importPlan)+    aesonImports =+      ["Value (..)"]+        <> (if any isConsumerScalar leaves then ["parseJSON", "toJSON"] else [])+        <> ["withText" | any (\leaf -> isId leaf || isEnum leaf) leaves]+    leafReferences leaf =+      nominalLeafTypeReference ctx leaf+        : case ((.kind) leaf, (.ownership) leaf) of+          (NominalIdLeaf _, GeneratedLeaf) ->+            [ generatedNominalValueReference ("parse" <> (.name) leaf),+              generatedNominalValueReference (lowerFirst ((.name) leaf) <> "Text")+            ]+          (NominalEnumLeaf constructors, GeneratedLeaf) ->+            generatedNominalValueReference (lowerFirst ((.name) leaf) <> "Text")+              : [generatedNominalConstructorReference constructor | (constructor, _) <- NE.toList constructors]+          (NominalEnumLeaf constructors, ConsumerLeaf binding) ->+            qualifiedValueReference ((.binding) binding)+              : nominalRepresentationEncoderReference ctx (resolvedNominalFromLeaf leaf)+              : [ nominalRepresentationConstructorReference ctx (resolvedNominalFromLeaf leaf) constructor+                | (constructor, _) <- NE.toList constructors+                ]+          (_, ConsumerLeaf binding) -> [qualifiedValueReference ((.binding) binding)]+          (NominalScalarLeaf {}, GeneratedLeaf) -> error "generated nominal scalar reached structural leaf emission"+    generatedNominalValueReference occurrence =+      HaskellReference (generatedNominalModule ctx) occurrence ValueNamespace RequireQualified+    generatedNominalConstructorReference occurrence =+      HaskellReference (generatedNominalModule ctx) occurrence ConstructorNamespace RequireQualified+    emitLeaf leaf = case ((.kind) leaf, (.ownership) leaf) of+      (NominalIdLeaf _, GeneratedLeaf) -> emitGeneratedId leaf+      (NominalIdLeaf prefix, ConsumerLeaf binding) -> emitConsumerId leaf prefix binding+      (NominalEnumLeaf constructors, GeneratedLeaf) -> emitGeneratedEnum leaf constructors+      (NominalEnumLeaf constructors, ConsumerLeaf binding) -> emitConsumerEnum leaf constructors binding+      (NominalScalarLeaf _, ConsumerLeaf binding) -> emitConsumerScalar leaf binding+      (NominalScalarLeaf {}, GeneratedLeaf) -> error "generated nominal scalar reached structural leaf emission"+    emitGeneratedId leaf =+      nl+        ( [ encodeName leaf <> " :: " <> leafType leaf <> " -> Value",+            encodeName leaf <> " = String . " <> generatedText leaf,+            "{-# NOINLINE " <> encodeName leaf <> " #-}",+            "",+            parseName leaf <> " :: Value -> Parser " <> leafType leaf,+            parseName leaf <> " = withText " <> tshow ((.name) leaf) <> " (either (fail . T.unpack) pure . " <> generatedParser leaf <> ")",+            "{-# NOINLINE " <> parseName leaf <> " #-}"+          ]+            <> if Set.member ((.name) leaf) keyedNames+              then+                [ "",+                  renderKeyName leaf <> " :: " <> leafType leaf <> " -> Text",+                  renderKeyName leaf <> " = " <> generatedText leaf,+                  "{-# NOINLINE " <> renderKeyName leaf <> " #-}",+                  "",+                  parseKeyName leaf <> " :: Text -> Parser " <> leafType leaf,+                  parseKeyName leaf <> " = either (fail . T.unpack) pure . " <> generatedParser leaf,+                  "{-# NOINLINE " <> parseKeyName leaf <> " #-}"+                ]+              else []+        )+    emitConsumerId leaf prefix binding =+      nl+        ( [ encodeName leaf <> " :: " <> leafType leaf <> " -> Value",+            encodeName leaf <> " = String . KindID.toText . nominalToRepresentation " <> bindingValue binding,+            "{-# NOINLINE " <> encodeName leaf <> " #-}",+            "",+            parseName leaf <> " :: Value -> Parser " <> leafType leaf,+            parseName leaf <> " = withText " <> tshow ((.name) leaf) <> " $ \\input ->",+            "  case parseKindIdV7Text @" <> tshow prefix <> " input of",+            "    Left reason -> fail (show reason)",+            "    Right representation -> pure (nominalFromRepresentation " <> bindingValue binding <> " representation)",+            "{-# NOINLINE " <> parseName leaf <> " #-}"+          ]+            <> if Set.member ((.name) leaf) keyedNames+              then+                [ "",+                  renderKeyName leaf <> " :: " <> leafType leaf <> " -> Text",+                  renderKeyName leaf <> " = KindID.toText . nominalToRepresentation " <> bindingValue binding,+                  "{-# NOINLINE " <> renderKeyName leaf <> " #-}",+                  "",+                  parseKeyName leaf <> " :: Text -> Parser " <> leafType leaf,+                  parseKeyName leaf <> " input = case parseKindIdV7Text @" <> tshow prefix <> " input of",+                  "  Left reason -> fail (show reason)",+                  "  Right representation -> pure (nominalFromRepresentation " <> bindingValue binding <> " representation)",+                  "{-# NOINLINE " <> parseKeyName leaf <> " #-}"+                ]+              else []+        )+    emitGeneratedEnum leaf constructors =+      nl $+        [ encodeName leaf <> " :: " <> leafType leaf <> " -> Value",+          encodeName leaf <> " = String . " <> generatedText leaf,+          "{-# NOINLINE " <> encodeName leaf <> " #-}",+          "",+          parseName leaf <> " :: Value -> Parser " <> leafType leaf,+          parseName leaf <> " = withText " <> tshow ((.name) leaf) <> " $ \\input -> case input of"+        ]+          <> ["  " <> tshow wire <> " -> pure " <> generatedConstructor constructor | (constructor, wire) <- NE.toList constructors]+          <> [ "  unknown -> " <> renderUnknownFailure ((.name) leaf <> " wire value") "unknown" (map snd (NE.toList constructors)),+               "{-# NOINLINE " <> parseName leaf <> " #-}"+             ]+    emitConsumerEnum leaf constructors binding =+      nl $+        [ encodeName leaf <> " :: " <> leafType leaf <> " -> Value",+          encodeName leaf <> " = String . " <> representationEncoder leaf <> " . nominalToRepresentation " <> bindingValue binding,+          "{-# NOINLINE " <> encodeName leaf <> " #-}",+          "",+          parseName leaf <> " :: Value -> Parser " <> leafType leaf,+          parseName leaf <> " = withText " <> tshow ((.name) leaf) <> " $ \\input -> case input of"+        ]+          <> [ "  "+                 <> tshow wire+                 <> " -> pure (nominalFromRepresentation "+                 <> bindingValue binding+                 <> " "+                 <> representationConstructor leaf constructor+                 <> ")"+             | (constructor, wire) <- NE.toList constructors+             ]+          <> [ "  unknown -> " <> renderUnknownFailure ((.name) leaf <> " wire value") "unknown" (map snd (NE.toList constructors)),+               "{-# NOINLINE " <> parseName leaf <> " #-}"+             ]+    emitConsumerScalar leaf binding =+      nl+        [ encodeName leaf <> " :: " <> leafType leaf <> " -> Value",+          encodeName leaf <> " = toJSON . nominalToRepresentation " <> bindingValue binding,+          "{-# NOINLINE " <> encodeName leaf <> " #-}",+          "",+          parseName leaf <> " :: Value -> Parser " <> leafType leaf,+          parseName leaf <> " value = nominalFromRepresentation " <> bindingValue binding <> " <$> parseJSON value",+          "{-# NOINLINE " <> parseName leaf <> " #-}"+        ]+    leafType = renderReferenceOrDie importPlan . nominalLeafTypeReference ctx+    generatedParser leaf = renderReferenceOrDie importPlan (generatedNominalValueReference ("parse" <> (.name) leaf))+    generatedText leaf = renderReferenceOrDie importPlan (generatedNominalValueReference (lowerFirst ((.name) leaf) <> "Text"))+    generatedConstructor = renderReferenceOrDie importPlan . generatedNominalConstructorReference+    representationEncoder = renderReferenceOrDie importPlan . nominalRepresentationEncoderReference ctx . resolvedNominalFromLeaf+    representationConstructor leaf = renderReferenceOrDie importPlan . nominalRepresentationConstructorReference ctx (resolvedNominalFromLeaf leaf)+    bindingValue = renderReferenceOrDie importPlan . qualifiedValueReference . (.binding)+    encodeName leaf = "encode" <> (.name) leaf <> "Leaf"+    parseName leaf = "parse" <> (.name) leaf <> "Leaf"+    renderKeyName leaf = "render" <> (.name) leaf <> "LeafKey"+    parseKeyName leaf = "parse" <> (.name) leaf <> "LeafKey"+    isConsumer leaf = case (.ownership) leaf of ConsumerLeaf {} -> True; GeneratedLeaf -> False+    isGeneratedId leaf = case ((.kind) leaf, (.ownership) leaf) of (NominalIdLeaf {}, GeneratedLeaf) -> True; _ -> False+    isConsumerId leaf = case ((.kind) leaf, (.ownership) leaf) of (NominalIdLeaf {}, ConsumerLeaf {}) -> True; _ -> False+    isConsumerScalar leaf = case ((.kind) leaf, (.ownership) leaf) of (NominalScalarLeaf {}, ConsumerLeaf {}) -> True; _ -> False+    isId leaf = case (.kind) leaf of NominalIdLeaf {} -> True; NominalEnumLeaf {} -> False; NominalScalarLeaf {} -> False+    isEnum leaf = case (.kind) leaf of NominalEnumLeaf {} -> True; NominalIdLeaf {} -> False; NominalScalarLeaf {} -> False++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 hasEnum nominals || any hasUnenforcedId 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+                   ", "+                   ( (if any hasId nominals then ["TextPattern", "matchesTextPattern", "textProjectionDomain"] else [])+                       <> ["finiteProjectionDomain" | any hasEnum nominals]+                       <> (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+    hasEnum nominal = case (.representation) nominal of EnumRepresentation {} -> 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 :),+        onKeyedMap = \key value -> ReqMap : ReqReference (nominalLeafTypeReference ctx key) : value,+        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 -> [],+        onNominal = pure . ReqReference . nominalLeafTypeReference ctx+      }++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,+          onKeyedMap = \key value ->+            applicationShapeType+              ( "Map "+                  <> renderReferenceOrDie importPlan (nominalLeafTypeReference ctx key)+                  <> " "+                  <> renderStrictOrApplicationArgument value+              ),+          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 -> error ("keiro-dsl internal invariant: shape type references missing mapped declaration " <> show key),+          onNominal = atomicShapeType . renderReferenceOrDie importPlan . nominalLeafTypeReference ctx+        }++nominalLeafTypeReference :: Context -> NominalLeaf -> HaskellReference+nominalLeafTypeReference ctx leaf = case (.ownership) leaf of+  GeneratedLeaf -> HaskellReference (generatedNominalModule ctx) ((.name) leaf) TypeNamespace RequireQualified+  ConsumerLeaf binding -> haskellTypeReference ((.haskell) binding)++resolvedNominalFromLeaf :: NominalLeaf -> ResolvedNominalType+resolvedNominalFromLeaf leaf =+  ResolvedNominalType+    { name = (.name) leaf,+      representation = case (.kind) leaf of+        NominalIdLeaf prefix -> IdRepresentation prefix+        NominalEnumLeaf constructors -> EnumRepresentation constructors+        NominalScalarLeaf representation -> ScalarRepresentation representation,+      ownership = case (.ownership) leaf of+        GeneratedLeaf -> GeneratedNominal+        ConsumerLeaf binding -> ConsumerNominal binding,+      loc = (.loc) leaf+    }++consumerNominalLeafTypeReference :: Context -> NominalLeaf -> HaskellReference+consumerNominalLeafTypeReference ctx leaf = case (.ownership) leaf of+  GeneratedLeaf -> HaskellReference (generatedNominalModule ctx) ((.name) leaf) TypeNamespace PreferUnqualified+  ConsumerLeaf binding -> haskellTypeReference ((.haskell) binding)++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,+    getter :: !Text,+    rawGetter :: !(Maybe Text),+    pointer :: !Text,+    owner :: !HaskellSource,+    result :: !Text,+    canonical :: !CanonicalTypeId,+    binding :: !QualifiedValueName,+    fixtures :: !QualifiedValueName,+    terminalNominal :: !(Maybe NominalLeaf),+    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, nominal) -> [mkProjection (keys <> [(.key) field]) (selectors <> [(shapeModuleForOwner, (.haskell) field)]) result nominal]+          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, nominal) -> [mkProjection (keys <> [(.key) field]) (selectors <> [(shapeModuleFor owner, (.haskell) field)]) result nominal]+          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 nominal =+      StructuralProjection+        { tag = nameStem <> "Projection",+          witness = lowerFirst nameStem <> "Witness",+          getter = lowerFirst nameStem <> "Get",+          rawGetter = (lowerFirst nameStem <> "RawGet") <$ nominal,+          pointer = pointer,+          owner = (.haskell) root,+          result = result,+          canonical = (.canonical) root,+          binding = (.binding) root,+          fixtures = (.fixtures) root,+          terminalNominal = nominal,+          selectors = selectors+        }+      where+        pointer = T.concat ["/" <> escapePointer key | key <- keys]+        nameStem = projectionNameStem ((.name) root) pointer++projectionScalar :: ResolvedTypeExpr -> Maybe (Text, Maybe NominalLeaf)+projectionScalar = \case+  RText -> primitive "Text"+  RInt -> primitive "Int"+  RInteger -> primitive "Integer"+  RBool -> primitive "Bool"+  RTime -> primitive "UTCTime"+  RNatural -> primitive "Natural"+  RJson -> Nothing+  ROptional {} -> Nothing+  RList {} -> Nothing+  RMap {} -> Nothing+  RKeyedMap {} -> Nothing+  RRef {} -> Nothing+  RNominal leaf -> Just (nominalResultType leaf, Just leaf)+  where+    primitive result = Just (result, Nothing)+    nominalResultType leaf = case (.kind) leaf of+      NominalIdLeaf {} -> "Text"+      NominalEnumLeaf {} -> "Text"+      NominalScalarLeaf representation -> case representation of+        NominalText -> "Text"+        NominalInt -> "Int"+        NominalNatural -> "Natural"+        NominalBool -> "Bool"+        NominalTime -> "UTCTime"++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",+          getter = lowerFirst nameStem <> suffix <> "Get",+          rawGetter = (lowerFirst nameStem <> suffix <> "RawGet") <$ spec.rawGetter,+          pointer = spec.pointer,+          owner = spec.owner,+          result = spec.result,+          canonical = spec.canonical,+          binding = spec.binding,+          fixtures = spec.fixtures,+          terminalNominal = spec.terminalNominal,+          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)++projectionRawGetterName :: TypeGraph -> MappedKey -> Text -> Maybe Text+projectionRawGetterName graph owner pointer = do+  ResolvedStructural declaration _ <- Map.lookup owner ((.declarations) graph)+  projection <-+    find+      (\spec -> (.canonical) spec == (.canonical) declaration && (.pointer) spec == pointer)+      (projectionSpecs graph)+  (.rawGetter) projection++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.",+           "-- Nominal ID and enum leaves carry exact canonical-text domains.",+           "-- Int, Natural, and UTCTime belong to Keiki's ordered subset.",+           "module " <> moduleName,+           "  ( " <> T.intercalate "\n  , " (concatMap projectionExports specs),+           "  ) where",+           ""+         ]+      <> staticImports+      <> fieldScopeImports+      <> T.lines (renderPlannedImports importPlan)+      <> concatMap renderProjection specs+  where+    moduleName = structuralProjectionModule ctx+    specs = map (resolveProjectionModules ctx) (projectionSpecs graph)+    exactSpecs = [spec | spec <- specs, maybe False projectionLeafHasExactDomain ((.terminalNominal) spec)]+    hasExact = not (null exactSpecs)+    hasExactId = any (maybe False projectionLeafIsId . (.terminalNominal)) exactSpecs+    hasExactEnum = any (maybe False projectionLeafIsEnum . (.terminalNominal)) exactSpecs+    hasExactConsumer = any (maybe False projectionLeafIsConsumer . (.terminalNominal)) exactSpecs+    resultTypes = Set.fromList (map (.result) specs)+    projectionExports spec = [(.witness) spec, (.getter) spec] <> maybeToList ((.rawGetter) spec)+    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 Data.List.NonEmpty (NonEmpty (..))" | hasExactEnum]+        <> ["import Data.List.NonEmpty qualified as NonEmpty" | hasExact]+        <> ["import Data.KindID qualified as KindID" | any (maybe False projectionLeafIsConsumerId . (.terminalNominal)) specs]+        <> [ "import Keiro.Codec.IdDomain (idDomainTextPattern, parseKindIdV7Text, typeIdV7Domain)"+           | hasExactId+           ]+        <> [ "import Keiro.Codec.Nominal (" <> T.intercalate ", " nominalCodecImports <> ")"+           | not (null nominalCodecImports)+           ]+        <> [ "import Keiro.Codec.Structural (" <> T.intercalate ", " structuralCodecImports <> ")"+           | not (null specs)+           ]+        <> ["import Keiki.Core (" <> T.intercalate ", " keikiCoreImports <> ")" | not (null specs)]+        <> [ "import Keiki.ProjectionDomain (" <> T.intercalate ", " projectionDomainImports <> ")"+           | hasExact+           ]+    nominalCodecImports =+      ["nominalToRepresentation" | any (maybe False projectionLeafIsConsumer . (.terminalNominal)) specs]+        <> ["nominalFromRepresentation" | hasExactConsumer]+    structuralCodecImports =+      ["bindingToShape"]+        <> if hasExact then ["bindingFromShape", "fixtureCases"] else []+    keikiCoreImports =+      ["FieldProjection (..)", "FieldWitness"]+        <> (if hasExact then ["ExactFieldProjection (..)", "exactFieldWitness"] else [])+        <> ["fieldWitness" | length exactSpecs /= length specs]+    projectionDomainImports =+      ["finiteProjectionDomain" | hasExactEnum]+        <> if hasExactId then ["TextPattern", "textProjectionDomain"] else []+    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 (concatMap (\spec -> [(.tag) spec, (.witness) spec, (.getter) spec, projectionPatternName spec] <> maybeToList ((.rawGetter) spec)) specs))+        ( Set.fromList+            ( [haskellTypeReference ((.owner) spec) | spec <- specs]+                <> [qualifiedValueReference ((.binding) spec) | spec <- specs]+                <> [qualifiedValueReference ((.fixtures) spec) | spec <- exactSpecs]+                <> [nominalLeafTypeReference ctx leaf | spec <- specs, Just leaf <- [(.terminalNominal) spec]]+                <> concatMap projectionConstructorReferences exactSpecs+                <> concatMap (maybe [] (projectionNominalReferences ctx) . (.terminalNominal)) specs+            )+        )+    renderProjection spec =+      [""]+        <> renderProjectionDomain spec+        <> [ "data " <> (.tag) spec,+             ""+           ]+        <> renderRawGetter spec+        <> [ (.getter) spec <> " :: " <> ownerType spec <> " -> " <> (.result) spec,+             (.getter) spec <> " owner = " <> renderProjectionGetter spec,+             "",+             "instance FieldProjection " <> (.tag) spec <> " where",+             "  type FieldName " <> (.tag) spec <> " = " <> tshow ((.pointer) spec),+             "  type FieldOwner " <> (.tag) spec <> " = " <> ownerType spec,+             "  type FieldResult " <> (.tag) spec <> " = " <> (.result) spec,+             "  fieldShapeId _ = " <> tshow (unCanonicalTypeId ((.canonical) spec)),+             "  projectFieldValue _ = " <> (.getter) spec+           ]+        <> renderExactProjection spec+        <> [ "",+             (.witness) spec <> " :: FieldWitness " <> (.tag) spec,+             (.witness) spec <> " = " <> witnessConstructor spec <> " @" <> (.tag) spec+           ]+    ownerType spec = renderReferenceOrDie importPlan (haskellTypeReference ((.owner) spec))+    renderRawGetter spec = case ((.rawGetter) spec, (.terminalNominal) spec) of+      (Just rawName, Just leaf) ->+        [ rawName <> " :: " <> ownerType spec <> " -> " <> renderReferenceOrDie importPlan (nominalLeafTypeReference ctx leaf),+          rawName <> " owner = " <> renderGetter spec,+          ""+        ]+      (Nothing, Nothing) -> []+      _ -> error "structural projection raw getter and terminal nominal disagree"+    witnessConstructor spec+      | isExactProjection spec = "exactFieldWitness"+      | otherwise = "fieldWitness"+    isExactProjection spec = maybe False projectionLeafHasExactDomain ((.terminalNominal) spec)+    renderProjectionDomain spec = case (.terminalNominal) spec of+      Just NominalLeaf {kind = NominalIdLeaf prefix} ->+        [ projectionPatternName spec <> " :: TextPattern",+          projectionPatternName spec <> " = either (error . show) id (idDomainTextPattern (typeIdV7Domain " <> tshow prefix <> "))",+          ""+        ]+      _ -> []+    renderExactProjection spec = case (.terminalNominal) spec of+      Just leaf+        | projectionLeafHasExactDomain leaf ->+            [ "",+              "instance ExactFieldProjection " <> (.tag) spec <> " where",+              "  fieldProjectionDomain _ = " <> projectionDomain spec leaf,+              "  reconstructFieldOwner _ value = do"+            ]+              <> map ("    " <>) (projectionNominalDecoder ctx importPlan leaf)+              <> [ "    let baseShape = bindingToShape " <> bindingValue spec <> " (snd (NonEmpty.head (fixtureCases " <> fixturesValue spec <> ")))",+                   "    pure (bindingFromShape " <> bindingValue spec <> " " <> renderProjectionReconstruction spec <> ")"+                 ]+      _ -> []+    projectionDomain spec leaf = case (.kind) leaf of+      NominalIdLeaf {} -> "textProjectionDomain " <> projectionPatternName spec+      NominalEnumLeaf constructors -> "finiteProjectionDomain (" <> renderNonEmpty (map (tshow . snd) (NE.toList constructors)) <> ")"+      NominalScalarLeaf {} -> error "nominal scalar reached exact structural projection rendering"+    bindingValue spec = renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) spec))+    fixturesValue spec = renderReferenceOrDie importPlan (qualifiedValueReference ((.fixtures) spec))+    projectionConstructorReferences spec =+      [ HaskellReference shapeModuleName constructor ConstructorNamespace RequireQualified+      | (shapeModuleName, _selector) <- (.selectors) spec,+        let (constructor, _fields) = projectionRecord shapeModuleName+      ]+    projectionRecord shapeModuleName = case Map.lookup (MappedKey (lastSegment shapeModuleName)) ((.declarations) graph) of+      Just (ResolvedStructural _ (RRecord constructor _ fields)) -> (constructor, fields)+      _ -> error "structural projection path owner is not a record"+    renderProjectionReconstruction spec = rebuild 0 "baseShape" ((.selectors) spec)+      where+        rebuild _ _ [] = error "cannot reconstruct an empty structural projection path"+        rebuild depth shape ((shapeModuleName, selected) : remaining) =+          "(case "+            <> shape+            <> " of "+            <> constructorName+            <> " "+            <> T.unwords patterns+            <> " -> "+            <> constructorName+            <> " "+            <> T.unwords arguments+            <> ")"+          where+            (constructor, fields) = projectionRecord shapeModuleName+            constructorName =+              renderReferenceOrDie importPlan (HaskellReference shapeModuleName constructor ConstructorNamespace RequireQualified)+            variables = ["projectionField" <> tshow' depth <> "_" <> tshow' index | index <- [0 .. length fields - 1]]+            selectedIndex = fromMaybe (error "structural projection selector disappeared") (findIndex ((== selected) . (.haskell)) fields)+            selectedVariable = variables !! selectedIndex+            patterns =+              [ if index == selectedIndex && null remaining then "_" else variable+              | (index, variable) <- zip [0 ..] variables+              ]+            replacement = case remaining of+              [] -> "fieldValue"+              _ -> rebuild (depth + 1) selectedVariable remaining+            arguments =+              [ if index == selectedIndex then replacement else variable+              | (index, variable) <- zip [0 ..] variables+              ]+    renderGetter spec =+      foldl+        ( \value (_shapeModuleName, selector) ->+            "(" <> value <> ")." <> selector+        )+        ("bindingToShape " <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) spec)) <> " owner")+        ((.selectors) spec)+    renderProjectionGetter spec = case (.terminalNominal) spec of+      Nothing -> renderGetter spec+      Just leaf -> case (.rawGetter) spec of+        Just rawName -> projectionNominalEncoder ctx importPlan leaf <> " (" <> rawName <> " owner)"+        Nothing -> error "nominal structural projection has no raw getter"++projectionPatternName :: StructuralProjection -> Text+projectionPatternName spec = lowerFirst ((.tag) spec) <> "DomainPattern"++projectionLeafHasExactDomain :: NominalLeaf -> Bool+projectionLeafHasExactDomain leaf = projectionLeafIsId leaf || projectionLeafIsEnum leaf++projectionLeafIsId :: NominalLeaf -> Bool+projectionLeafIsId NominalLeaf {kind = NominalIdLeaf {}} = True+projectionLeafIsId _ = False++projectionLeafIsEnum :: NominalLeaf -> Bool+projectionLeafIsEnum NominalLeaf {kind = NominalEnumLeaf {}} = True+projectionLeafIsEnum _ = False++projectionLeafIsConsumer :: NominalLeaf -> Bool+projectionLeafIsConsumer NominalLeaf {ownership = ConsumerLeaf {}} = True+projectionLeafIsConsumer _ = False++projectionLeafIsConsumerId :: NominalLeaf -> Bool+projectionLeafIsConsumerId NominalLeaf {kind = NominalIdLeaf {}, ownership = ConsumerLeaf {}} = True+projectionLeafIsConsumerId _ = False++projectionNominalReferences :: Context -> NominalLeaf -> [HaskellReference]+projectionNominalReferences ctx leaf = case ((.kind) leaf, (.ownership) leaf) of+  (NominalIdLeaf {}, GeneratedLeaf) -> [generatedTextReference, generatedValueReference ("parse" <> (.name) leaf)]+  (NominalEnumLeaf constructors, GeneratedLeaf) ->+    generatedTextReference+      : [generatedConstructorReference constructor | (constructor, _) <- NE.toList constructors]+  (NominalIdLeaf {}, ConsumerLeaf binding) -> [qualifiedValueReference ((.binding) binding)]+  (NominalEnumLeaf constructors, ConsumerLeaf binding) ->+    [ qualifiedValueReference ((.binding) binding),+      nominalRepresentationEncoderReference ctx nominal+    ]+      <> [nominalRepresentationConstructorReference ctx nominal constructor | (constructor, _) <- NE.toList constructors]+  (NominalScalarLeaf {}, ConsumerLeaf binding) -> [qualifiedValueReference ((.binding) binding)]+  (NominalScalarLeaf {}, GeneratedLeaf) -> error "generated nominal scalar reached structural projection planning"+  where+    nominal = resolvedNominalFromLeaf leaf+    generatedTextReference = HaskellReference (generatedNominalModule ctx) (nominalTextName nominal) ValueNamespace RequireQualified+    generatedValueReference occurrence = HaskellReference (generatedNominalModule ctx) occurrence ValueNamespace RequireQualified+    generatedConstructorReference occurrence = HaskellReference (generatedNominalModule ctx) occurrence ConstructorNamespace RequireQualified++projectionNominalDecoder :: Context -> HaskellImportPlan -> NominalLeaf -> [Text]+projectionNominalDecoder ctx importPlan leaf = case ((.kind) leaf, (.ownership) leaf) of+  (NominalIdLeaf {}, GeneratedLeaf) ->+    [ "fieldValue <- either (const Nothing) Just (" <> rendered (generatedValueReference ("parse" <> (.name) leaf)) <> " value)"+    ]+  (NominalIdLeaf prefix, ConsumerLeaf binding) ->+    [ "representation <- either (const Nothing) Just (parseKindIdV7Text @" <> tshow prefix <> " value)",+      "let fieldValue = nominalFromRepresentation " <> rendered (qualifiedValueReference ((.binding) binding)) <> " representation"+    ]+  (NominalEnumLeaf constructors, GeneratedLeaf) ->+    ["fieldValue <- case value of"]+      <> [ "  " <> tshow wire <> " -> Just " <> rendered (generatedConstructorReference constructor)+         | (constructor, wire) <- NE.toList constructors+         ]+      <> ["  _ -> Nothing"]+  (NominalEnumLeaf constructors, ConsumerLeaf binding) ->+    ["fieldValue <- case value of"]+      <> [ "  "+             <> tshow wire+             <> " -> Just (nominalFromRepresentation "+             <> rendered (qualifiedValueReference ((.binding) binding))+             <> " "+             <> rendered (nominalRepresentationConstructorReference ctx nominal constructor)+             <> ")"+         | (constructor, wire) <- NE.toList constructors+         ]+      <> ["  _ -> Nothing"]+  (NominalScalarLeaf {}, _) -> error "nominal scalar reached exact structural projection decoding"+  where+    nominal = resolvedNominalFromLeaf leaf+    generatedValueReference occurrence = HaskellReference (generatedNominalModule ctx) occurrence ValueNamespace RequireQualified+    generatedConstructorReference occurrence = HaskellReference (generatedNominalModule ctx) occurrence ConstructorNamespace RequireQualified+    rendered = renderReferenceOrDie importPlan++projectionNominalEncoder :: Context -> HaskellImportPlan -> NominalLeaf -> Text+projectionNominalEncoder ctx importPlan leaf = case ((.kind) leaf, (.ownership) leaf) of+  (NominalIdLeaf {}, GeneratedLeaf) -> rendered generatedTextReference+  (NominalEnumLeaf {}, GeneratedLeaf) -> rendered generatedTextReference+  (NominalIdLeaf {}, ConsumerLeaf binding) ->+    "(KindID.toText . nominalToRepresentation " <> rendered (qualifiedValueReference ((.binding) binding)) <> ")"+  (NominalEnumLeaf {}, ConsumerLeaf binding) ->+    "("+      <> rendered (nominalRepresentationEncoderReference ctx nominal)+      <> " . nominalToRepresentation "+      <> rendered (qualifiedValueReference ((.binding) binding))+      <> ")"+  (NominalScalarLeaf {}, ConsumerLeaf binding) ->+    "(nominalToRepresentation " <> rendered (qualifiedValueReference ((.binding) binding)) <> ")"+  (NominalScalarLeaf {}, GeneratedLeaf) -> error "generated nominal scalar reached structural projection rendering"+  where+    nominal = resolvedNominalFromLeaf leaf+    generatedTextReference = HaskellReference (generatedNominalModule ctx) (nominalTextName nominal) ValueNamespace RequireQualified+    rendered = renderReferenceOrDie importPlan++resolveProjectionModules :: Context -> StructuralProjection -> StructuralProjection+resolveProjectionModules ctx spec =+  StructuralProjection+    { tag = spec.tag,+      witness = spec.witness,+      getter = spec.getter,+      rawGetter = spec.rawGetter,+      pointer = spec.pointer,+      owner = spec.owner,+      result = spec.result,+      canonical = spec.canonical,+      binding = spec.binding,+      fixtures = spec.fixtures,+      terminalNominal = spec.terminalNominal,+      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) Map.empty++-- | 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) leaves+  where+    leaves = case checkedTypeGraph service of+      Left failures -> error ("checked contract type graph failed during scaffolding: " <> show failures)+      Right graph -> (.nominalLeaves) graph++scaffoldContractWithLanguage :: Context -> EffectiveLanguageContract -> Map.Map Name NominalLeaf -> ContractNode -> [ScaffoldModule]+scaffoldContractWithLanguage ctx languageContract nominalLeaves c =+  [ ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/Contract.hs"),+        text = emitContractGen ctx languageContract genPrefix nominalLeaves c,+        kind = Generated,+        origin = nodeOrigin "contract" ((.name) c) ((.loc) c)+      }+  ]+  where+    genPrefix = genPrefixFor ctx (pascal ((.name) c))++emitContractGen :: Context -> EffectiveLanguageContract -> Text -> Map.Map Name NominalLeaf -> ContractNode -> Text+emitContractGen ctx languageContract genPrefix nominalLeaves 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+        ++ T.lines (renderPlannedImports importPlan)+        ++ [ "import Data.Text (Text)",+             "import qualified Data.Text as T"+           ]+        ++ ["import Keiro.Codec.IdDomain (parseKindIdV7Value)" | hasLiteralTypedTypeIds]+        ++ [ "",+             "-- topic constants"+           ]+        ++ topicConstants+        ++ [ "",+             "-- the closed payload set (discriminated by " <> tshow ((.discriminator) c) <> ")"+           ]+        ++ [emitPayloadAdt languageContract contractValueType 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)+    hasLiteralTypedTypeIds = any (any (isLiteralTypedTypeId . (.valueType)) . (.fields)) ((.events) c)+    usesPlainFieldDecode = any (any (not . isTypedTypeId . (.valueType)) . (.fields)) ((.events) c)+    moduleName = genPrefix <> ".Contract"+    declaredLeaves =+      Map.fromList+        [ (name, declaredLeaf name)+        | event <- (.events) c,+          field <- (.fields) event,+          CDeclaredId name <- [(.valueType) field]+        ]+    importPlan =+      planImportsOrDie+        moduleName+        Set.empty+        ( Set.fromList+            [ reference+            | leaf <- Map.elems declaredLeaves,+              reference <-+                [ nominalLeafTypeReference ctx leaf,+                  declaredLeafHelperReference "encode" leaf,+                  declaredLeafHelperReference "parse" leaf+                ]+            ]+        )+    declaredLeaf name = case Map.lookup name nominalLeaves of+      Just leaf@NominalLeaf {kind = NominalIdLeaf {}} -> leaf+      _ -> error ("checked contract declared ID is missing from the nominal leaf graph: " <> T.unpack name)+    declaredLeafHelperReference prefix leaf =+      HaskellReference+        (structuralNominalLeavesModule ctx)+        (prefix <> (.name) leaf <> "Leaf")+        ValueNamespace+        RequireQualified+    renderedDeclaredLeafHelper prefix name =+      renderReferenceOrDie importPlan (declaredLeafHelperReference prefix (declaredLeaf name))+    contractValueType CText = "Text"+    contractValueType CInt = "Int"+    contractValueType (CTypeId prefix)+      | isJust (contractIdDomainContractFor languageContract prefix) = "(KindID " <> tshow prefix <> ")"+      | otherwise = "Text"+    contractValueType (CDeclaredId name) =+      renderReferenceOrDie importPlan (nominalLeafTypeReference ctx (declaredLeaf name))+    pragmas =+      renderGeneratedLanguagePragmas+        ( [ExtDuplicateRecordFields | contractNeedsDuplicateRecordFields c]+            <> [ExtOverloadedRecordDot | contractUsesRecordDot c]+        )+    typedKindIdImports+      | hasLiteralTypedTypeIds = ["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 CDeclaredId {} = True+    isTypedTypeId _ = False+    isLiteralTypedTypeId (CTypeId prefix) = isJust (contractIdDomainContractFor languageContract prefix)+    isLiteralTypedTypeId _ = 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+          CDeclaredId name -> renderedDeclaredLeafHelper "encode" name <> " 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+      CDeclaredId name -> "explicitParseField " <> renderedDeclaredLeafHelper "parse" name <> " 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 -> (ContractType -> Text) -> Text -> [ContractEvent] -> Text+emitPayloadAdt languageContract valueType tyName events =+  sectionsOf [map dataRecord events, [sumDecl]]+  where+    hasTypedTypeIds = any (any (isTypedTypeId . (.valueType)) . (.fields)) events+    isTypedTypeId (CTypeId prefix) = isJust (contractIdDomainContractFor languageContract prefix)+    isTypedTypeId CDeclaredId {} = True+    isTypedTypeId _ = False+    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"+         ]+      ++ modeExports+      ++ [ "  , inboxDispositionFor",+           "  , inboxDisposition",+           "  ) where",+           "",+           "import Data.Text (Text)",+           modeImport,+           "",+           "-- The dedupe policy (hole-kind 4), lowered to the live InboxDedupePolicy.",+           "inboxDedupePolicy :: InboxDedupePolicy",+           "inboxDedupePolicy = " <> (.dedupePolicy) i,+           ""+         ]+      ++ modeDefinitions+      ++ [ "-- 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"+    modeExports = case (.idempotence) i of+      IdemInboxTable -> ["  , inboxPersistence"]+      IdemDelegated -> ["  , inboxIdempotence", "  , runInboxIntake"]+    modeImport = case (.idempotence) i of+      IdemInboxTable -> "import Keiro.Inbox.Types (InboxDedupePolicy (..), InboxPersistence (..), InboxResult (..), RetryDelay (..))"+      IdemDelegated -> "import Effectful (Eff, IOE, (:>))\nimport Keiro.Inbox (runInboxDelegated)\nimport Keiro.Inbox.Types (DelegatedOutcome, InboxDedupePolicy (..), InboxError, InboxIdempotence (..), InboxResult (..), KafkaDeliveryRef, RetryDelay (..))\nimport Keiro.Integration.Event (IntegrationEvent)\nimport Keiro.Telemetry (KeiroMetrics)"+    modeDefinitions = case (.idempotence) i of+      IdemInboxTable ->+        [ "-- | 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),+          ""+        ]+      IdemDelegated ->+        [ "-- | The downstream state machine owns the durable dedupe receipt.",+          "inboxIdempotence :: InboxIdempotence",+          "inboxIdempotence = IdempotenceDelegated",+          "",+          "-- | Run this intake without reading or writing the Keiro inbox table.",+          "runInboxIntake ::",+          "  IOE :> es =>",+          "  Maybe KeiroMetrics ->",+          "  IntegrationEvent ->",+          "  Maybe KafkaDeliveryRef ->",+          "  (Text -> IntegrationEvent -> Eff es (DelegatedOutcome a)) ->",+          "  Eff es (Either InboxError (InboxResult a))",+          "runInboxIntake metrics event delivery =",+          "  runInboxDelegated metrics inboxDedupePolicy event delivery",+          ""+        ]++--------------------------------------------------------------------------------+-- 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)+    selectedNominals = Set.unions (map ((.nominalDependencies) . (.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+          [ consumerNominalLeafTypeReference ctx leaf+          | name <- Set.toAscList selectedNominals,+            Just leaf@NominalLeaf {ownership = GeneratedLeaf} <- [Map.lookup name ((.nominalLeaves) graph)]+          ]+        <> 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 || not (Set.null keyedMapNames) || any isEnumShape (map snd structuralDeclarations)+    usesWithText = any isTextShape (map snd structuralDeclarations)+    usesUnknownRejection = any rejectsUnknown (map snd structuralDeclarations)+    usesOptionalField = any hasOptionalField (map snd structuralDeclarations)+    usesLocatedContainers = any typeUsesLocatedContainer allExpressions+    keyedMapNames = Set.unions (map keyedMapNominalNames allExpressions)+    usesKeyMap = usesUnknownRejection || usesOptionalField || not (Set.null keyedMapNames)+    usesKeyModule = usesKeyMap || usesMap+    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" | usesKeyModule]+        <> ["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]+        <> [nominalLeafCodecImport ctx selectedNominals | not (Set.null selectedNominals)]+        <> [nominalLeafKeyCodecImport ctx keyedMapNames | not (Set.null keyedMapNames)]+        <> 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]+        <> (if usesLocatedContainers then ["JSONPathElement (..)", "(<?>)"] else [])+        <> ["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 (generatedNominalModule ctx) 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 (\_ -> id) (const False) (const False))++typeUsesTime :: ResolvedTypeExpr -> Bool+typeUsesTime = foldTypeExpr (TypeExprAlgebra False False False False False True False id id id (\_ -> id) (const False) (const False))++typeUsesText :: ResolvedTypeExpr -> Bool+typeUsesText = foldTypeExpr (TypeExprAlgebra True False False False False False False id id (const True) (\_ -> id) (const False) (const False))++typeUsesJson :: ResolvedTypeExpr -> Bool+typeUsesJson = foldTypeExpr (TypeExprAlgebra False False False False False False True id id id (\_ -> id) (const False) (const False))++typeUsesParserAnnotation :: ResolvedTypeExpr -> Bool+typeUsesParserAnnotation = foldTypeExpr (TypeExprAlgebra False False False False False False False id (const True) (const True) (\_ _ -> True) (const False) (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,+        onKeyedMap = \_ _ -> True,+        onRef = \key -> case Map.lookup key ((.declarations) graph) of+          Just ResolvedOpaque {} -> True+          _ -> False,+        onNominal = const 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 a positive batch size, visibility timeout, and polling; the spec owns ordering. Legacy FIFO modes reject batch sizes greater than one.",+      "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"+      WqFifoHeads -> "FifoHeads"+    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 ctx 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 :: Context -> Text -> TypeGraph -> Text -> ReadModelNode -> ReadModelQueryTypes -> Text+emitReadModelQueryContract ctx 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)+        <> Set.fromList+          [ consumerNominalLeafTypeReference ctx leaf+          | expression <- expressions,+            leaf@NominalLeaf {ownership = GeneratedLeaf} <- directNominalLeaves expression+          ]+    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)+    directNominalLeaves =+      foldTypeExpr+        TypeExprAlgebra+          { onText = [],+            onInt = [],+            onInteger = [],+            onBool = [],+            onNatural = [],+            onTime = [],+            onJson = [],+            onOptional = id,+            onList = id,+            onMap = id,+            onKeyedMap = \key value -> key : value,+            onRef = const [],+            onNominal = pure+          }+    renderType expression =+      unHaskellTypeOccurrence $+        either+          (error . ("validated read-model consumer type rendering failed: " <>) . show)+          id+          (renderConsumerType (generatedNominalModule ctx) 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"+  CheckedIdLiteral _ value -> tshow value+  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 [" (" <> renderCheckedCommandScalar graph (commandExpression field) <> ")" | field <- (.fields) command]+    <> ")"+  where+    commandExpression field =+      fromMaybe+        (error "checked declarative router command field disappeared")+        (Map.lookup ((.name) field) ((.commandFields) selection))++renderCheckedCommandScalar :: TypeGraph -> CheckedScalarExpr -> Text+renderCheckedCommandScalar graph expression = case ((.valueType) expression, (.node) expression) of+  (SelectionNominal {}, CheckedPath root segments) ->+    "(StructuralProjections."+      <> rawGetterName segments+      <> " "+      <> rootName root+      <> ")"+  _ -> renderCheckedScalar graph expression+  where+    rootName SelectionInput = "input"+    rootName SelectionRow = "row"+    rawGetterName [] = error "checked nominal command path contained no fields"+    rawGetterName path@(first : _) =+      fromMaybe+        (error "checked nominal command path has no generated structural raw getter")+        (projectionRawGetterName graph ((.owner) first) pointer)+      where+        pointer = T.concat ["/" <> escapePointer ((.wireKey) segment) | segment <- path]++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 = case (.body) p of+  ReactionProcessBody reaction -> scaffoldReactionProcess ctx p reaction+  LegacyProcessBody {} -> scaffoldLegacyProcess ctx p++scaffoldReactionProcess :: Context -> ProcessNode -> ReactionBody -> [ScaffoldModule]+scaffoldReactionProcess ctx process reaction =+  [ ScaffoldModule+      { path = modulePath inputPrefix "Input",+        text = emitReactionInput ctx inputPrefix process reaction,+        kind = Generated,+        origin = nodeOrigin "process input" ((.id) process) ((.loc) process)+      },+    ScaffoldModule+      { path = modulePath inputPrefix "Process",+        text = emitReactionProcessGen ctx inputPrefix holePrefix process reaction,+        kind = Generated,+        origin = nodeOrigin "process reaction" ((.id) process) ((.loc) process)+      },+    ScaffoldModule+      { path = T.unpack (T.replace "." "/" holePrefix <> "/ProcessHoles.hs"),+        text = emitReactionProcessHoles inputPrefix holePrefix process,+        kind = HoleStub,+        origin = nodeOrigin "process decoder" ((.id) process) ((.loc) process)+      }+  ]+  where+    inputPrefix = genPrefixFor ctx ((.id) process)+    holePrefix = holePrefixFor ctx ((.id) process)+    modulePath prefix leaf = T.unpack (T.replace "." "/" prefix <> "/" <> leaf <> ".hs")++emitReactionInput :: Context -> Text -> ProcessNode -> ReactionBody -> Text+emitReactionInput ctx genPrefix process reaction =+  nl $+    renderGeneratedLanguagePragmas [ExtDeriveAnyClass, ExtDuplicateRecordFields]+      <> [ generatedBanner,+           "module " <> genPrefix <> ".Input (" <> inputType <> " (..)) where",+           "",+           "import Data.Aeson (FromJSON, ToJSON)"+         ]+      <> ["import Data.Text (Text)" | usesType [Nothing, Just "Text"]]+      <> ["import Data.Time (UTCTime)" | usesType [Just "Time"]]+      <> [ "import GHC.Generics (Generic)"+         ]+      <> ["import Numeric.Natural (Natural)" | usesType [Just "Natural"]]+      <> ["import " <> contextGeneratedPrefix ctx <> ".Nominals qualified as N" | usesNominal]+      <> [ "",+           "data " <> inputType+         ]+      <> concat (zipWith renderCtor [0 :: Int ..] (NE.toList ((.inputs) reaction)))+      <> ["  deriving stock (Generic, Eq, Show)", "  deriving anyclass (FromJSON, ToJSON)"]+  where+    inputType = pascal ((.id) process) <> "Input"+    inputFields = concatMap (.fields) (NE.toList ((.inputs) reaction))+    usesType candidates = any ((`elem` candidates) . (.valueType)) inputFields+    usesNominal = any (\field -> maybe False (`notElem` ["Text", "Int", "Integer", "Bool", "Natural", "Time"]) ((.valueType) field)) inputFields+    renderCtor index input =+      [ (if index == 0 then "  = " else "  | ") <> (.name) input,+        "      { " <> T.intercalate "\n      , " [(.name) field <> " :: !" <> renderReactionFieldType field | field <- (.fields) input],+        "      }"+      ]++renderReactionFieldType :: Field -> Text+renderReactionFieldType field = renderReactionTypeName ((.valueType) field)++renderReactionTypeName :: Maybe Name -> Text+renderReactionTypeName = \case+  Nothing -> "Text"+  Just "Text" -> "Text"+  Just "Int" -> "Int"+  Just "Integer" -> "Integer"+  Just "Bool" -> "Bool"+  Just "Natural" -> "Natural"+  Just "Time" -> "UTCTime"+  Just name -> "N." <> name++emitReactionProcessHoles :: Text -> Text -> ProcessNode -> Text+emitReactionProcessHoles genPrefix holePrefix process =+  nl+    [ "-- keiro-dsl process-hole contract v1",+      "-- HAND-OWNED typed decoder; created once and never overwritten.",+      "module " <> holePrefix <> ".ProcessHoles (decode" <> processType <> "Input) where",+      "",+      "import " <> genPrefix <> ".Input (" <> processType <> "Input)",+      "import Kiroku.Store.Types (RecordedEvent)",+      "",+      "decode" <> processType <> "Input :: RecordedEvent -> Maybe " <> processType <> "Input",+      "decode" <> processType <> "Input = error \"fill decode" <> processType <> "Input\""+    ]+  where+    processType = pascal ((.id) process)++emitReactionProcessGen :: Context -> Text -> Text -> ProcessNode -> ReactionBody -> Text+emitReactionProcessGen ctx genPrefix holePrefix process reaction =+  nl $+    renderGeneratedLanguagePragmas ([ExtDuplicateRecordFields, ExtOverloadedRecordDot] <> [ExtDeriveAnyClass | hasTimers])+      <> [ "{-# OPTIONS_GHC -Wno-missing-signatures #-}",+           generatedBanner,+           "module " <> genPrefix <> ".Process",+           "  ( " <> inputType <> " (..)",+           "  , " <> lo <> "ProcessName",+           "  , " <> lo <> "Category",+           "  , " <> lo <> "ProcessWorkerOptions",+           "  , " <> lo <> "ReactionVersion",+           "  , " <> lo <> "ReactionFingerprint",+           "  , " <> lo <> "React",+           "  , " <> lo <> "ProcessManager",+           "  , " <> lo <> "RunProcessWorker"+         ]+      <> concatMap timerExports timers+      <> (if hasTimers then ["  , " <> lo <> "TimerWorkerOptions", "  , " <> lo <> "FireTimer"] else [])+      <> [ "  ) where",+           "",+           "import Data.Text (Text)"+         ]+      <> ["import Data.Aeson (FromJSON, ToJSON)" | hasTimers]+      <> ["import Data.Aeson qualified as Aeson" | hasTimers]+      <> ["import Data.ByteString qualified as BS" | hasTimers]+      <> ["import Data.Text qualified as T" | processNeedsTextPack]+      <> ["import Data.Text.Encoding (encodeUtf8)" | hasTimers]+      <> ["import Data.Time (UTCTime, addUTCTime)" | hasTimers]+      <> ["import Data.UUID (UUID)" | hasTimers]+      <> ["import Data.UUID.V5 qualified as UUID.V5" | hasTimers]+      <> ["import GHC.Generics (Generic)" | hasTimers]+      <> [ "import Numeric.Natural (Natural)",+           "import " <> genPrefix <> ".Input (" <> inputType <> " (..))",+           "import " <> holePrefix <> ".ProcessHoles (decode" <> processType <> "Input)",+           "import " <> sagaPrefix <> ".Domain qualified as Saga",+           "import " <> sagaPrefix <> ".EventStream (" <> sagaStreamValue <> ", " <> sagaStreamType <> ")",+           "import " <> targetPrefix <> ".Domain qualified as Target",+           "import " <> targetPrefix <> ".EventStream (" <> T.intercalate ", " ([targetEventCategory | hasTimers] <> [targetCategory | hasDispatches] <> [targetStreamValue]) <> ")"+         ]+      <> ["import " <> contextGeneratedPrefix ctx <> ".Nominals qualified as N" | processNeedsNominals]+      <> [ "import Keiro.Command (DomainCommandHandler (..), SilentDomainDecision (..))"+         ]+      <> ["import Keiro.Command (CommandError (..), RunCommandOptions (..), runCommand)" | hasTimers]+      <> ["import Keiro.ProcessManager (" <> T.intercalate ", " (["PMCommand (..)" | hasDispatches] <> ["confirmBenignDuplicate" | hasTimers]) <> ")" | hasDispatches || hasTimers]+      <> [ "import Keiro.ProcessManager.Reaction qualified as Reaction",+           "import Keiro.Stream qualified as Stream"+         ]+      <> ["import Keiro.DeterministicId (identitySeedBytes)" | hasTimers]+      <> ["import Keiro.Timer (TimerId (..), TimerRequest (..), TimerWorkerOptions (..))" | hasTimers]+      <> ["import Kiroku.Store.Types (EventId (..))" | hasTimers]+      <> workerPolicyImports ((.poison) process)+      <> concatMap renderTimerPayload timers+      <> [ "",+           lo <> "ProcessName :: Text",+           lo <> "ProcessName = " <> tshow ((.name) process),+           "",+           lo <> "Category :: Stream.StreamCategory " <> sagaStreamType,+           lo <> "Category = Stream.categoryUnsafe " <> tshow ((.category) ((.saga) process)),+           ""+         ]+      <> workerOptionsLines (lo <> "ProcessWorkerOptions") ((.rejected) process) ((.poison) process)+      <> renderTimerWorkerOptions+      <> [ "",+           lo <> "ReactionVersion :: Natural",+           lo <> "ReactionVersion = " <> T.pack (show ((.version) reaction)),+           "",+           lo <> "ReactionFingerprint :: Text",+           lo <> "ReactionFingerprint = " <> tshow (processReactionFingerprintFrom reaction),+           "",+           lo <> "Correlate :: " <> inputType <> " -> Text",+           lo <> "Correlate input = case input of"+         ]+      <> map ("  " <>) (map renderCorrelation (NE.toList ((.inputs) reaction)))+      <> [ "",+           lo <> "React :: " <> inputType <> " -> Reaction.ReactionPlan Saga." <> sagaCommandType <> " Target." <> targetCommandType,+           lo <> "React input = case input of"+         ]+      <> concatMap renderReaction (NE.toList ((.reactions) reaction))+      <> [ "",+           lo <> "ProcessManager =",+           "  Reaction.ReactiveProcessManager",+           "    { name = " <> lo <> "ProcessName",+           "    , correlate = " <> lo <> "Correlate",+           "    , sagaHandler = DomainCommandHandler { eventStream = " <> sagaStreamValue <> ", classifySilent = \\_ -> SilentNoOp () }",+           "    , streamFor = Stream.entityStream " <> lo <> "Category",+           "    , targetEventStream = " <> targetStreamValue,+           "    , targetProjections = const []",+           "    , react = " <> lo <> "React",+           "    }",+           "",+           lo <> "RunProcessWorker options adapter =",+           "  Reaction.runReactiveProcessManagerWorkerWith",+           "    " <> lo <> "ProcessWorkerOptions",+           "    options",+           "    " <> lo <> "ProcessManager",+           "    adapter",+           "    (\\event -> case decode" <> processType <> "Input event of Nothing -> Nothing; Just input -> Just (event, input))"+         ]+      <> renderFireTimer+  where+    processType = pascal ((.id) process)+    inputType = processType <> "Input"+    lo = lowerFirst ((.id) process)+    sagaName = pascal ((.agg) ((.saga) process))+    targetName = pascal ((.target) process)+    sagaPrefix = genPrefixFor ctx sagaName+    targetPrefix = genPrefixFor ctx targetName+    sagaStreamValue = lowerFirst sagaName <> "EventStream"+    sagaStreamType = sagaName <> "EventStreamDef"+    targetStreamValue = lowerFirst targetName <> "EventStream"+    targetEventCategory = lowerFirst targetName <> "Category"+    targetCategory = lowerFirst targetName <> "CommandCategory"+    sagaCommandType = sagaName <> "Command"+    targetCommandType = targetName <> "Command"+    timers = (.timers) reaction+    hasTimers = not (null timers)+    hasDispatches = any reactionNodeHasDispatch (NE.toList ((.reactions) reaction))+    reactionNodeHasDispatch node = any armHasDispatch (NE.toList ((.arms) node))+    armHasDispatch arm = case (.body) arm of+      NoAction -> False+      ArmActions {advance, followUps} -> any isDispatch followUps || maybe False (any isDispatch . fromMaybe [] . (.accepted)) advance+    isDispatch FollowDispatch {} = True+    isDispatch _ = False+    correlationInput = NE.head ((.inputs) reaction)+    correlationType = find ((== (.field) ((.correlate) process)) . (.name)) ((.fields) correlationInput) >>= (.valueType)+    processNeedsTextPack = hasTimers || maybe False (`elem` ["Int", "Integer", "Bool", "Natural", "Time"]) correlationType+    processNeedsNominals =+      maybe False (`notElem` ["Text", "Int", "Integer", "Bool", "Natural", "Time"]) correlationType+        || any reactionHasQualifiedLiteral (NE.toList ((.reactions) reaction))+        || any timerUsesNominal timers++    timerExports timer =+      [ "  , " <> timerPayloadType timer <> " (..)",+        "  , " <> timerRequestBuilder timer+      ]++    timerPayloadType timer = pascal ((.name) timer) <> "Payload"+    timerRequestBuilder timer = lo <> pascal ((.name) timer) <> "TimerRequest"+    payloadArgument field = "payload" <> pascal (payloadFieldName field)+    payloadFieldName = \case+      PayloadConstant name _ -> name+      PayloadTyped name _ -> name+    payloadFieldType = \case+      PayloadConstant {} -> "Text"+      PayloadTyped _ valueType -> renderReactionTypeName valueType+    timerUsesNominal timer = any payloadUsesNominal ((.payload) timer)+    payloadUsesNominal = \case+      PayloadConstant {} -> False+      PayloadTyped _ Nothing -> False+      PayloadTyped _ (Just valueType) -> valueType `notElem` ["Text", "Int", "Integer", "Bool", "Natural", "Time"]++    renderTimerPayload timer =+      [ "",+        "data " <> timerPayloadType timer <> " = " <> timerPayloadType timer,+        "  { " <> T.intercalate "\n  , " [payloadFieldName field <> " :: !" <> payloadFieldType field | field <- (.payload) timer],+        "  }",+        "  deriving stock (Generic, Eq, Show)",+        "  deriving anyclass (FromJSON, ToJSON)",+        "",+        timerRequestBuilder timer <> " :: " <> T.intercalate " -> " (["Text", "UTCTime"] <> map payloadFieldType dynamicFields <> ["TimerRequest"]),+        timerRequestBuilder timer <> " correlationId fireAtTime " <> T.unwords (map payloadArgument dynamicFields) <> " =",+        "  TimerRequest",+        "    { timerId = " <> timerIdExpression timer "correlationId",+        "    , processManagerName = " <> lo <> "ProcessName",+        "    , correlationId = correlationId",+        "    , fireAt = fireAtTime",+        "    , payload = Aeson.toJSON (" <> timerPayloadType timer <> " { " <> T.intercalate ", " (map payloadAssignment ((.payload) timer)) <> " })",+        "    }"+      ]+      where+        dynamicFields = [field | field@PayloadTyped {} <- (.payload) timer]+        payloadAssignment field = case field of+          PayloadConstant name value -> name <> " = " <> tshow value+          PayloadTyped name _ -> name <> " = " <> payloadArgument field++    renderTimerWorkerOptions = case (.timerPolicy) reaction of+      Nothing -> []+      Just policy ->+        [ "",+          lo <> "TimerWorkerOptions :: TimerWorkerOptions",+          lo <> "TimerWorkerOptions =",+          "  TimerWorkerOptions",+          "    { maxAttempts = Just " <> T.pack (show ((.maxAttempts) policy)),+          "    , requeueStuckAfter = Just 300",+          "    }",+          "-- Operator dead-letter guidance: " <> tshow ((.deadLetter) policy)+        ]++    renderFireTimer+      | not hasTimers = []+      | otherwise =+          [ "",+            lo <> "FireTimer options timer"+          ]+            <> [ "  | timer.timerId == " <> timerIdExpression timer "timer.correlationId" <> " = " <> timerFireFunction timer <> " options timer"+               | timer <- timers+               ]+            <> [ "  | otherwise = pure Nothing"+               ]+            <> concatMap renderTimerFire timers+            <> [ "",+                 "reactionIdentity :: Text -> Text -> UUID",+                 "reactionIdentity prefix correlation =",+                 "  UUID.V5.generateNamed UUID.V5.namespaceURL (identitySeedBytes (T.concat (map field [prefix, correlation])))",+                 "  where",+                 "    field value = T.pack (show (BS.length (encodeUtf8 value))) <> \":\" <> value"+               ]++    timerFireFunction timer = lo <> pascal ((.name) timer) <> "Fire"+    timerIdExpression timer correlation = "TimerId (reactionIdentity " <> tshow ((.prefix) ((.id) timer)) <> " " <> correlation <> ")"++    renderTimerFire timer =+      [ "",+        timerFireFunction timer <> " options timer",+        "  | timer.processManagerName /= " <> lo <> "ProcessName = pure Nothing",+        "  | otherwise =",+        "      case (Aeson.fromJSON timer.payload :: Aeson.Result " <> timerPayloadType timer <> ") of",+        "        Aeson.Error _ -> pure Nothing",+        "        Aeson.Success decoded -> do",+        "          let firedId = EventId (reactionIdentity " <> tshow ((.prefix) ((.firedEventId) ((.fire) timer))) <> " timer.correlationId)",+        "              target = Stream.entityStream " <> targetEventCategory <> " " <> renderFireKey ((.key) ((.fire) timer)),+        "          result <-",+        "            runCommand",+        "              (options { eventIds = [firedId] })",+        "              " <> targetStreamValue,+        "              target",+        "              (" <> renderFireCommand timer <> ")",+        "          case result of",+        "            Right {} -> pure (" <> renderFireOutcome "firedId" ((.onOk) disposition) <> ")",+        "            Left err -> do",+        "              benign <- confirmBenignDuplicate (Stream.streamName target) firedId err",+        "              pure $ if benign then Just firedId else case err of",+        "                CommandRejected -> " <> renderFireOutcome "firedId" ((.onReject) disposition),+        "                CommandAmbiguous _ -> " <> renderFireOutcome "firedId" ((.onAmbiguous) disposition),+        "                _ -> " <> renderFireOutcome "firedId" ((.onError) disposition)+      ]+      where+        disposition = (.disposition) ((.fire) timer)++    renderFireKey key+      | key == "correlationId" = "timer.correlationId"+      | otherwise = tshow key++    renderFireCommand timer =+      "Target."+        <> (.command) fire+        <> " (Target."+        <> (.command) fire+        <> "Data { "+        <> T.intercalate ", " ["Target." <> (.name) binding <> " = " <> renderFireBinding binding | binding <- (.fields) fire]+        <> " })"+      where+        fire = (.fire) timer++    renderFireBinding binding = case (.value) binding of+      Nothing -> "decoded." <> (.name) binding+      Just "timer.id" -> "timer.timerId"+      Just "timerId" -> "timer.timerId"+      Just "correlationId" -> "timer.correlationId"+      Just value -> case T.stripPrefix "input." value of+        Just fieldName -> "decoded." <> fieldName+        Nothing -> "decoded." <> value++    renderFireOutcome firedId = \case+      OFired -> "Just " <> firedId+      ORetry -> "Nothing"++    renderCorrelation input =+      (.name) input <> " { " <> fieldName <> " } -> " <> renderTextField input fieldName+      where+        fieldName = (.field) ((.correlate) process)++    renderReaction reactionNode =+      case find ((== (.on) reactionNode) . (.name)) (NE.toList ((.inputs) reaction)) of+        Nothing -> error "checked reaction input disappeared during generation"+        Just input ->+          let armLines = renderArms input (NE.toList ((.arms) reactionNode))+           in ["  " <> renderReactionPattern input reactionNode armLines] <> armLines++    renderReactionPattern input reactionNode armLines+      | all ((== NoAction) . (.body)) (NE.toList ((.arms) reactionNode)) = (.name) input <> " {}"+      | otherwise = (.name) input <> " { " <> T.intercalate ", " (map renderField ((.fields) input)) <> " }"+      where+        usedNames = T.split (\character -> not (isAlphaNum character || character == '_')) (T.unlines armLines)+        renderField field+          | (.name) field `elem` usedNames = (.name) field+          | otherwise = (.name) field <> " = _" <> (.name) field++    renderArms input [arm] | (.guard) arm == UnconditionalArm = ["    -> " <> renderPlan input ((.body) arm)]+    renderArms input arms =+      [ "    | " <> renderReactionGuard ((.guard) arm) <> " -> " <> renderPlan input ((.body) arm)+      | arm <- arms+      ]++    renderPlan _ NoAction = "Reaction.NoAdvance []"+    renderPlan input ArmActions {advance = Nothing, followUps} = "Reaction.NoAdvance " <> renderFollowUps input followUps+    renderPlan input ArmActions {advance = Just advance, followUps} =+      "Reaction.AdvanceReaction { command = "+        <> renderCommand "Saga" ((.command) advance) ((.fields) advance)+        <> ", followUps = "+        <> renderFollowUps input followUps+        <> ", onAccepted = "+        <> renderFollowUps input (fromMaybe [] ((.accepted) advance))+        <> " }"++    renderFollowUps input = listText . map (renderFollowUp input)+    renderFollowUp input = \case+      FollowDispatch dispatch ->+        "Reaction.FollowDispatch (PMCommand (Stream.entityStream "+          <> targetCategory+          <> " "+          <> renderDispatchKey input ((.key) dispatch)+          <> ") ("+          <> renderCommand "Target" ((.command) dispatch) ((.fields) dispatch)+          <> "))"+      FollowSchedule schedule ->+        case find ((== (.timer) schedule) . (.name)) timers of+          Nothing -> error "checked reaction schedule disappeared during generation"+          Just timer ->+            "Reaction.FollowSchedule Reaction."+              <> (case (.mode) schedule of ScheduleRearm -> "Rearm"; ScheduleOnce -> "Once")+              <> " ("+              <> timerRequestBuilder timer+              <> " "+              <> renderTextField input ((.field) ((.correlate) process))+              <> " (addUTCTime "+              <> windowText ((.window) ((.fireAt) schedule))+              <> " "+              <> (.field) ((.fireAt) schedule)+              <> ")"+              <> T.concat [" " <> renderScheduleBinding schedule field | field@PayloadTyped {} <- (.payload) timer]+              <> ")"+      FollowCancel timerName _ ->+        case find ((== timerName) . (.name)) timers of+          Nothing -> error "checked reaction cancellation disappeared during generation"+          Just timer ->+            "Reaction.FollowCancel ("+              <> timerIdExpression timer (renderTextField input ((.field) ((.correlate) process)))+              <> ")"++    renderScheduleBinding schedule payloadField =+      case find ((== payloadFieldName payloadField) . (.name)) ((.bindings) schedule) of+        Nothing -> error "checked timer payload binding disappeared during generation"+        Just binding -> renderReactionBinding binding++    renderCommand qualifier command bindings =+      qualifier+        <> "."+        <> command+        <> " ("+        <> qualifier+        <> "."+        <> command+        <> "Data { "+        <> T.intercalate ", " [qualifier <> "." <> (.name) binding <> " = " <> renderReactionBinding binding | binding <- bindings]+        <> " })"++    renderReactionBinding binding = case (.value) binding of+      Nothing -> (.name) binding+      Just value -> fromMaybe value (T.stripPrefix "input." value)++    renderDispatchKey input key = case T.stripPrefix "input." key of+      Just fieldName -> renderTextField input fieldName+      Nothing -> key++    renderTextField input fieldName = case find ((== fieldName) . (.name)) ((.fields) input) >>= (.valueType) of+      Nothing -> fieldName+      Just "Text" -> fieldName+      Just typeName | typeName `elem` ["Int", "Integer", "Bool", "Natural", "Time"] -> "T.pack (show " <> fieldName <> ")"+      Just typeName -> "(N." <> lowerFirst typeName <> "Text " <> fieldName <> ")"++renderReactionGuard :: ArmGuard -> Text+renderReactionGuard UnconditionalArm = "otherwise"+renderReactionGuard OtherwiseArm = "otherwise"+renderReactionGuard (WhenArm expression) = renderGuardExpr expression++reactionHasQualifiedLiteral :: ReactionNode -> Bool+reactionHasQualifiedLiteral reactionNode = any armHasQualified (NE.toList ((.arms) reactionNode))+  where+    armHasQualified arm = case (.guard) arm of+      WhenArm expression -> exprHasQualified expression+      _ -> False+    exprHasQualified = \case+      EOr left right -> exprHasQualified left || exprHasQualified right+      EAnd left right -> exprHasQualified left || exprHasQualified right+      ECmp _ left right -> exprHasQualified left || exprHasQualified right+      EAdd _ left right -> exprHasQualified left || exprHasQualified right+      ESubtract _ left right -> exprHasQualified left || exprHasQualified right+      EMultiply _ left right -> exprHasQualified left || exprHasQualified right+      ELiteral _ LiteralQualified {} -> True+      _ -> False++renderGuardExpr :: Expr -> Text+renderGuardExpr = \case+  EOr left right -> binary "||" left right+  EAnd left right -> binary "&&" left right+  ECmp operator left right -> binary (renderCmp operator) left right+  EAdd _ left right -> binary "+" left right+  ESubtract _ left right -> binary "-" left right+  EMultiply _ left right -> binary "*" left right+  EPath _ UnqualifiedRoot ["input", field] -> field+  EPath _ _ path -> T.intercalate "." path+  ELiteral _ literal -> case literal of+    LiteralText value -> tshow value+    LiteralIntegral value -> T.pack (show value)+    LiteralBool True -> "True"+    LiteralBool False -> "False"+    LiteralQualified _ constructor -> "N." <> constructor+    LiteralId typeName value -> "N.parse" <> typeName <> " " <> tshow value+  EAtom (AName name) -> name+  EAtom (ABool True) -> "True"+  EAtom (ABool False) -> "False"+  where+    binary operator left right = "(" <> renderGuardExpr left <> " " <> operator <> " " <> renderGuardExpr right <> ")"+    renderCmp = \case+      OpEq -> "=="+      OpNeq -> "/="+      OpLt -> "<"+      OpLe -> "<="+      OpGt -> ">"+      OpGe -> ">="++listText :: [Text] -> Text+listText values = "[" <> T.intercalate ", " values <> "]"++scaffoldLegacyProcess :: Context -> ProcessNode -> [ScaffoldModule]+scaffoldLegacyProcess 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 = legacyProcessTimer 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) (legacyProcessHandle 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) (legacyProcessTimer p)) <> " for the timer fire,",+      "--   keyed by correlationId; the fired-event-id is the deterministic uuidv5 of",+      "--   " <> tshow ((.prefix) ((.firedEventId) ((.fire) (legacyProcessTimer 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."+    ]++legacyProcessHandle :: ProcessNode -> HandleNode+legacyProcessHandle process = case (.body) process of+  LegacyProcessBody _ handle _ -> handle+  ReactionProcessBody {} -> error "keiro-dsl internal invariant: reaction process used by legacy generator"++legacyProcessTimer :: ProcessNode -> TimerNode+legacyProcessTimer process = case (.body) process of+  LegacyProcessBody _ _ timer -> timer+  ReactionProcessBody {} -> error "keiro-dsl internal invariant: reaction process used by legacy generator"++--------------------------------------------------------------------------------+-- 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 || codecUsesMap 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]+      ++ codecNominalRuntimeImports 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]+      ++ [nl (codecNominalLeafImports a) | not (null (codecNominalLeafImports 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]+    <> (if codecUsesLocatedContainers aggregate then ["JSONPathElement (..)", "(<?>)"] else [])+    <> ["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+    || any declarationUsesKeyedMap (codecMappedDeclarations aggregate)+  where+    declarationUsesKeyedMap (ResolvedStructural _ shape) = any typeUsesKeyedMap (shapeTypeExpressions shape)+    declarationUsesKeyedMap ResolvedOpaque {} = False++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++codecUsesLocatedContainers :: Agg -> Bool+codecUsesLocatedContainers = any declarationUsesLocatedContainer . codecMappedDeclarations+  where+    declarationUsesLocatedContainer (ResolvedStructural _ shape) = any typeUsesLocatedContainer (shapeTypeExpressions shape)+    declarationUsesLocatedContainer 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 (\expression -> typeUsesOptional expression || typeUsesKeyedMap expression) (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,+        onKeyedMap = \_ _ -> True,+        onRef = const False,+        onNominal = const False+      }++typeUsesKeyedMap :: ResolvedTypeExpr -> Bool+typeUsesKeyedMap = not . Set.null . keyedMapNominalNames++keyedMapNominalNames :: ResolvedTypeExpr -> Set.Set Name+keyedMapNominalNames =+  foldTypeExpr+    TypeExprAlgebra+      { onText = Set.empty,+        onInt = Set.empty,+        onInteger = Set.empty,+        onBool = Set.empty,+        onNatural = Set.empty,+        onTime = Set.empty,+        onJson = Set.empty,+        onOptional = id,+        onList = id,+        onMap = id,+        onKeyedMap = \key value -> Set.insert ((.name) key) value,+        onRef = const Set.empty,+        onNominal = const Set.empty+      }++typeUsesLocatedContainer :: ResolvedTypeExpr -> Bool+typeUsesLocatedContainer =+  foldTypeExpr+    TypeExprAlgebra+      { onText = False,+        onInt = False,+        onInteger = False,+        onBool = False,+        onNatural = False,+        onTime = False,+        onJson = False,+        onOptional = id,+        onList = const True,+        onMap = const True,+        onKeyedMap = \_ _ -> True,+        onRef = const False,+        onNominal = 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,+        onKeyedMap = \_ -> id,+        onRef = const False,+        onNominal = 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,+        onKeyedMap = \_ _ -> True,+        onRef = \key -> case (.typeGraph) aggregate >>= \graph -> Map.lookup key ((.declarations) graph) of+          Just ResolvedOpaque {} -> True+          _ -> False,+        onNominal = const 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++codecNominalRuntimeImports :: Agg -> [Text]+codecNominalRuntimeImports aggregate = case (hasConsumerNominalCodec aggregate, hasConsumerNominalDefault aggregate) of+  (True, _) -> ["import Keiro.Codec.Nominal (nominalFromRepresentation, nominalToRepresentation)"]+  (False, True) -> ["import Keiro.Codec.Nominal (nominalFromRepresentation)"]+  (False, False) -> []++hasConsumerNominalDefault :: Agg -> Bool+hasConsumerNominalDefault aggregate =+  any+    hasDefault+    [ field+    | ResolvedStructural _ (RRecord _ _ fields) <- codecMappedDeclarations aggregate,+      field <- fields+    ]+  where+    hasDefault field = case ((.valueType) field, (.onMissing) field) of+      (RNominal NominalLeaf {kind = NominalEnumLeaf {}, ownership = ConsumerLeaf {}}, Just OmCtor {}) -> True+      _ -> False++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 <> nominalDefaultReferences <> 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+              ]+      ]+    nominalDefaultReferences =+      [ reference+      | ResolvedStructural _ shape <- codecMappedDeclarations aggregate,+        field <- case shape of RRecord _ _ fields -> fields; REnum {} -> []; RUnion {} -> [],+        Just (leaf, constructor) <- [nominalConstructorDefault field],+        reference <- case (.ownership) leaf of+          GeneratedLeaf ->+            [ HaskellReference+                (generatedNominalModule ((.context) aggregate))+                constructor+                ConstructorNamespace+                RequireQualified+            ]+          ConsumerLeaf binding ->+            [ qualifiedValueReference ((.binding) binding),+              nominalRepresentationConstructorReference ((.context) aggregate) (resolvedNominalFromLeaf leaf) constructor+            ]+      ]+    nominalConstructorDefault field = case ((.valueType) field, (.onMissing) field) of+      (RNominal leaf@NominalLeaf {kind = NominalEnumLeaf {}}, Just (OmCtor constructor)) -> Just (leaf, constructor)+      _ -> Nothing+    shapeReferences =+      [ reference+      | ResolvedStructural declaration shape <- codecMappedDeclarations aggregate,+        reference <- structuralShapeReferences ((.context) aggregate) declaration shape+      ]++codecNominalImports :: Agg -> [Text]+codecNominalImports _ = []++codecNominalLeafImports :: Agg -> [Text]+codecNominalLeafImports aggregate =+  [nominalLeafCodecImport ((.context) aggregate) names | not (Set.null names)]+    <> [nominalLeafKeyCodecImport ((.context) aggregate) keyNames | not (Set.null keyNames)]+  where+    names = case (.typeGraph) aggregate of+      Nothing -> Set.empty+      Just graph ->+        Set.unions+          [ Map.findWithDefault Set.empty (MappedKey ((.name) declaration)) ((.nominalReachability) graph)+          | ResolvedStructural declaration _ <- codecMappedDeclarations aggregate+          ]+    keyNames =+      Set.unions+        [ keyedMapNominalNames expression+        | ResolvedStructural _ shape <- codecMappedDeclarations aggregate,+          expression <- shapeTypeExpressions shape+        ]++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,+        onKeyedMap = \_ -> id,+        onRef = pure,+        onNominal = const []+      }++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+    RNominal leaf@NominalLeaf {kind = NominalEnumLeaf {}} -> case (.ownership) leaf of+      GeneratedLeaf ->+        renderReferenceOrDie+          importPlan+          (HaskellReference (generatedNominalModule ctx) constructor ConstructorNamespace RequireQualified)+      ConsumerLeaf binding ->+        "(nominalFromRepresentation "+          <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding))+          <> " "+          <> renderReferenceOrDie importPlan (nominalRepresentationConstructorReference ctx (resolvedNominalFromLeaf leaf) constructor)+          <> ")"     _ -> constructor  objectEntries :: [Text] -> [Text]
src/Keiro/Dsl/ScaffoldRecord.hs view
@@ -5,12 +5,14 @@ module Keiro.Dsl.ScaffoldRecord   ( ScaffoldRecord (..),     ScaffoldModuleRoleRow (..),+    ProcessReactionRecordRow (..),     GeneratedHaskellNamingEdition (..),     renderRecord,     parseRecord,     recordFileName,     projectionCatalogFacts,     projectionCatalogFactsForService,+    processReactionRowsForService,   ) where @@ -30,12 +32,14 @@ import Keiro.Dsl.HaskellName (GeneratedHaskellNamingEdition (..), parseGeneratedHaskellNamingEdition, renderGeneratedHaskellNamingEdition) import Keiro.Dsl.LanguageVersion (SourceLanguage (..)) import Keiro.Dsl.MappedConsumer (MappingIdentity (..))+import Keiro.Dsl.ProcessReaction (CheckedProcessReaction (..), checkProcessReaction) import Keiro.Dsl.ProjectionSupply import Keiro.Dsl.ReadModelQueryContract (QueryContractIdentity, queryContractIdentityKey) import Keiro.Dsl.Scaffold (ModuleKind (..), ModuleRole (..))-import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedProjectionSupplies, checkedSpec, effectiveLanguageContract)+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedLanguageContract, checkedProjectionSupplies, checkedSpec, checkedTypeGraph, effectiveLanguageContract) import Keiro.Dsl.SemanticImpact (SemanticImpactSnapshot) import Keiro.Dsl.SidecarNames (contextLedgerFileName)+import Numeric.Natural (Natural) import System.FilePath (isAbsolute, splitDirectories)  data ScaffoldRecord = ScaffoldRecord@@ -56,6 +60,7 @@     queryContractBaseline :: !Bool,     queryContracts :: ![QueryContractIdentity],     routerSelections :: ![RouterSelectionSnapshot],+    processReactions :: ![ProcessReactionRecordRow],     semanticImpact :: !(Maybe SemanticImpactSnapshot)   }   deriving stock (Eq, Show)@@ -67,6 +72,37 @@   }   deriving stock (Eq, Show) +-- | Checked process-reaction identity retained by the scaffold ledger. The+-- prefixed JSON row is forward-compatible with older readers, which ignore+-- unknown row kinds.+data ProcessReactionRecordRow = ProcessReactionRecordRow+  { processName :: !Text,+    verification :: !Text,+    version :: !(Maybe Natural),+    fingerprint :: !(Maybe Text),+    holeObligations :: ![Text]+  }+  deriving stock (Eq, Show)++instance Aeson.ToJSON ProcessReactionRecordRow where+  toJSON row =+    Aeson.object+      [ "processName" .= (.processName) row,+        "verification" .= (.verification) row,+        "version" .= (.version) row,+        "fingerprint" .= (.fingerprint) row,+        "holeObligations" .= (.holeObligations) row+      ]++instance Aeson.FromJSON ProcessReactionRecordRow where+  parseJSON = Aeson.withObject "ProcessReactionRecordRow" $ \fields ->+    ProcessReactionRecordRow+      <$> fields .: "processName"+      <*> fields .: "verification"+      <*> fields Aeson..:? "version"+      <*> fields Aeson..:? "fingerprint"+      <*> fields .: "holeObligations"+ instance Aeson.ToJSON ScaffoldModuleRoleRow where   toJSON row =     Aeson.object@@ -119,6 +155,7 @@       <> ["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))+      <> map ("process-reaction " <>) (map (Text.decodeUtf8 . BL.toStrict . Aeson.encode) ((.processReactions) record))       <> ["semantic-impact " <> Text.decodeUtf8 (BL.toStrict (Aeson.encode snapshot)) | Just snapshot <- [(.semanticImpact) record]]   where     rootLabel = if T.null ((.moduleRoot) record) then "(none)" else (.moduleRoot) record@@ -157,8 +194,9 @@         queryContractBaseline <- parseQueryContractBaseline rows         queryContracts <- traverse parseQueryContract (filter ("query-contract " `T.isPrefixOf`) rows)         routerSelections <- traverse parseRouterSelection (filter ("router-selection " `T.isPrefixOf`) rows)+        processReactions <- traverse parseProcessReaction (filter ("process-reaction " `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 (.router) routerSelections)+        if hasDuplicateMappingNames mappings || hasDuplicates idDomains || hasDuplicates nominalEqualities || hasDuplicateBindingObligations bindingEntries || hasDuplicateBehaviorRequirements behaviorEntries || hasDuplicates catalogFacts || hasDuplicates (map queryContractIdentityKey queryContracts) || hasDuplicates (map (.router) routerSelections) || hasDuplicates (map (.processName) processReactions)           then Nothing           else             pure@@ -180,6 +218,7 @@                   queryContractBaseline = queryContractBaseline,                   queryContracts = queryContracts,                   routerSelections = routerSelections,+                  processReactions = processReactions,                   semanticImpact = semanticImpact                 }   _ -> Nothing@@ -212,6 +251,9 @@     parseRouterSelection row = do       payload <- T.stripPrefix "router-selection " row       Aeson.decodeStrict' (Text.encodeUtf8 payload)+    parseProcessReaction row = do+      payload <- T.stripPrefix "process-reaction " row+      Aeson.decodeStrict' (Text.encodeUtf8 payload)     parseQueryContractBaseline rows = case filter ("query-contract-baseline " `T.isPrefixOf`) rows of       [] -> Just False       ["query-contract-baseline v1"] -> Just True@@ -282,6 +324,41 @@ mappingRowPrefix :: MappingIdentity -> Text mappingRowPrefix NominalMapping {} = "nominal-mapping " mappingRowPrefix _ = "mapping "++processReactionRowsForService :: CheckedService -> Either (NE.NonEmpty Text) [ProcessReactionRecordRow]+processReactionRowsForService service =+  traverse rowFor [process | NProcess process <- (.nodes) spec]+  where+    spec = checkedSpec service+    rowFor process = case (.body) process of+      LegacyProcessBody {} ->+        Right+          ProcessReactionRecordRow+            { processName = (.name) process,+              verification = "custom-unverified",+              version = Nothing,+              fingerprint = Nothing,+              holeObligations = []+            }+      ReactionProcessBody {} -> case checkedTypeGraph service of+        Left failures -> Left (T.pack ("checked service type graph did not resolve for process ledger: " <> show failures) NE.:| [])+        Right graph -> case checkProcessReaction (checkedLanguageContract service) graph spec process of+          Left failures -> Left (T.pack ("validated process reaction did not check for process ledger: " <> show failures) NE.:| [])+          Right checked ->+            Right+              ProcessReactionRecordRow+                { processName = (.name) process,+                  verification = (.verification) checked,+                  version = Just ((.version) checked),+                  fingerprint = Just ((.fingerprint) checked),+                  holeObligations = decoderObligation process : (.holeObligations) checked+                }+    decoderObligation process =+      "decode"+        <> (.id) process+        <> "Input :: RecordedEvent -> Maybe "+        <> (.id) process+        <> "Input"  -- | Canonical durable catalog identities used when a declaration disappears -- from the next graph. Source lines remain part of the attribution evidence.
src/Keiro/Dsl/ScaffoldRun.hs view
@@ -97,13 +97,13 @@     renderConformancePackageFailure,     renderConformancePackageReport,   )-import Keiro.Dsl.CoordinationImpact (RouterSelectionDrift, renderRouterSelectionDrift, routerSelectionDrift, routerSelectionSnapshots)+import Keiro.Dsl.CoordinationImpact (ProcessReactionDrift, ProcessReactionSnapshot (..), RouterSelectionDrift, processReactionDrift, processReactionSnapshots, renderProcessReactionDrift, 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.Harness (harnessForServiceWithGoldens, harnessProcessForService, harnessReadModelForService, harnessRouterForService, harnessWorkflow) import Keiro.Dsl.HaskellName (currentGeneratedHaskellNamingEdition) import Keiro.Dsl.HaskellName qualified as HaskellName import Keiro.Dsl.HaskellSourceMove@@ -116,7 +116,7 @@ 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.ScaffoldRecord (ProcessReactionRecordRow (..), ScaffoldModuleRoleRow (..), ScaffoldRecord (..), parseRecord, processReactionRowsForService, projectionCatalogFactsForService, recordFileName, renderRecord) import Keiro.Dsl.SemanticContract (CheckedService, checkedLanguageContract, checkedService, checkedSpec, checkedTypeGraph, effectiveLanguageContract, legacyCheckedService) import Keiro.Dsl.SemanticImpact   ( MappedImpactDelta (..),@@ -137,7 +137,7 @@ 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.TypeGraph (MappedKey (..), RootRef (..), TypeGraph (..), UseSite (..)) import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode (..), Severity (..), validateService) import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, removeFile, renameFile) import System.FilePath (takeDirectory, (</>))@@ -156,6 +156,7 @@   | FirewallBreach ![(FilePath, Text, Int)]   | LoweringRefusal ![Text]   | MissingGeneratedBanner ![FilePath]+  | HoleContractDrift ![(FilePath, Text, Text)]   | ImportCycle ![Text]   | BehaviorRefusal ![BehaviorDerivationError]   | BehaviorSourceRefusal ![BehaviorSourceFailure]@@ -170,6 +171,7 @@   | DuplicateConformanceFactKeys ![DuplicateServiceFactKey]   | ConformancePackageRefusal !ConformancePackageFailure   | GeneratedNameInvariantViolation ![Text]+  | ProcessReactionRefusal ![Text]   | NameMigrationRequired ![SourceMove]   | NameMigrationRefusal ![Text]   | SidecarMigrationRequired ![SidecarMove]@@ -292,10 +294,12 @@     queryContractMigrations :: ![QueryContractMigration],     semanticImpact :: !SemanticImpactReport,     routerSelectionDrift :: ![RouterSelectionDrift],+    processReactionCoordinationDrift :: ![ProcessReactionDrift],     projectionMappedImpact :: !(Maybe ProjectionMappedImpact),     generatedArtifactImpact :: ![GeneratedArtifactImpact],     sourceLanguageDrift :: !(Maybe SourceLanguageDrift),     newHoles :: ![BindingHole],+    processReactionRows :: ![ProcessReactionRecordRow],     addedBehavior :: ![BehaviorRecordRow],     removedBehavior :: ![BehaviorRecordRow],     obsoleteOutputHooks :: ![(Text, Text)],@@ -332,7 +336,7 @@       <> concat         [ case node of             NAggregate agg -> scaffoldAggregateForService ctx service agg <> harnessForServiceWithGoldens goldens ctx service agg-            NProcess process -> scaffoldProcess ctx process <> harnessProcess ctx process+            NProcess process -> scaffoldProcess ctx process <> harnessProcessForService ctx service process             NRouter router -> scaffoldRouterForService ctx service router <> harnessRouterForService ctx service router             NContract contract -> scaffoldContractForService ctx service contract             NIntake intake -> scaffoldIntake ctx intake@@ -1100,6 +1104,12 @@             [contextCabalFragmentFileName ((.context) spec), recordFileName ((.context) spec)]         pure (either (Left . pure . GeneratedHaskellEditionRefusal) Right prepared)     executeCheckedScaffold editionMigration sidecarMoves preparedPackage =+      case processReactionSnapshots service of+        Left failures -> pure (Left [ProcessReactionRefusal (NE.toList failures)])+        Right currentProcessReactions -> case processReactionRowsForService service of+          Left failures -> pure (Left [ProcessReactionRefusal (NE.toList failures)])+          Right processReactionRows -> executeCheckedScaffoldReady editionMigration sidecarMoves preparedPackage currentProcessReactions processReactionRows+    executeCheckedScaffoldReady editionMigration sidecarMoves preparedPackage currentProcessReactions processReactionRows =       case deriveBehaviorRequirementsForService service of         Left errors -> pure (Left [BehaviorRefusal errors])         Right requirements -> do@@ -1107,96 +1117,103 @@           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+              holeDrifts <- processHoleContractDrift out modules+              if not (null holeDrifts)+                then pure (Left [HoleContractDrift holeDrifts])+                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+                                  reactionDrift = maybe [] (\previous -> processReactionDrift (map processRecordSnapshot ((.processReactions) previous)) currentProcessReactions) 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 processReactionRows))+                              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,+                                      processReactionCoordinationDrift = reactionDrift,+                                      projectionMappedImpact = projectionMappedImpactForService service,+                                      generatedArtifactImpact = generatedArtifactImpact dispositions,+                                      sourceLanguageDrift = languageDrift,+                                      newHoles = newHoles,+                                      processReactionRows = processReactionRows,+                                      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 []@@ -1379,7 +1396,7 @@     let registerRoots =           Set.fromList             [ key-            | RootRegister _ _ key <- (.useSites) graph+            | UseSite {root = RootRegister _ _, mappedKey = key} <- (.useSites) graph             ]      in map (constraintFor registerRoots) ((.mappings) plan)   where@@ -1544,8 +1561,8 @@                   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 =+currentRecord :: FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> Bool -> [BehaviorRecordRow] -> SemanticImpactSnapshot -> [ProcessReactionRecordRow] -> ScaffoldRecord+currentRecord specPath sourceLanguage ctx service modules queryHistoryBaseline currentBehavior currentSemanticImpact processReactionRows =   ScaffoldRecord     { specPath = T.pack specPath,       moduleRoot = (.moduleRoot) ctx,@@ -1564,9 +1581,19 @@       queryContractBaseline = queryHistoryBaseline,       queryContracts = either (const []) id (queryContractIdentitiesForService service),       routerSelections = routerSelectionSnapshots service,+      processReactions = processReactionRows,       semanticImpact = Just currentSemanticImpact     } +processRecordSnapshot :: ProcessReactionRecordRow -> ProcessReactionSnapshot+processRecordSnapshot row =+  ProcessReactionSnapshot+    { process = (.processName) row,+      verification = (.verification) row,+      version = (.version) row,+      fingerprint = (.fingerprint) row+    }+ missingGeneratedBanners :: FilePath -> [ScaffoldModule] -> IO [FilePath] missingGeneratedBanners out modules = fmap concat $ mapM check generated   where@@ -1580,6 +1607,26 @@           contents <- TIO.readFile path           pure [(.path) m | not (any isGeneratedBannerLine (T.lines contents))] +processHoleContractDrift :: FilePath -> [ScaffoldModule] -> IO [(FilePath, Text, Text)]+processHoleContractDrift out = fmap concat . mapM check . filter isVersionedProcessHole+  where+    isVersionedProcessHole module_ =+      (.kind) module_ == HoleStub+        && maybe False ("-- keiro-dsl process-hole contract " `T.isPrefixOf`) (firstLine ((.text) module_))+    check module_ = do+      let path = out </> (.path) module_+          expected = maybe "(missing)" id (firstLine ((.text) module_))+      exists <- doesFileExist path+      if not exists+        then pure []+        else do+          existing <- TIO.readFile path+          let actual = maybe "(missing)" id (firstLine existing)+          pure [((.path) module_, expected, actual) | actual /= expected]+    firstLine contents = case T.lines contents of+      line : _ -> Just line+      [] -> Nothing+ writeModule :: FilePath -> ScaffoldModule -> IO (ScaffoldModule, WriteDisposition) writeModule out m = do   let path = out </> (.path) m@@ -1625,6 +1672,11 @@     requiresEditionMigration = \case       GeneratedHaskellEditionRequired _ -> True       _ -> False+    renderHoleDrift (path, expected, actual) =+      [ "  " <> T.pack path,+        "    expected: " <> expected,+        "    actual:   " <> actual+      ]     render (PathCollision path origins) =       [ "error: module path collision -- refusing to scaffold; nothing was written",         "  " <> T.pack path@@ -1643,6 +1695,9 @@       ]         <> map ("  " <>) (map T.pack paths)         <> ["  (adopted as hand code? move it, or re-run with --force-generated-overwrite)", "nothing was written"]+    render (HoleContractDrift drifts) =+      ["error: hole contract drift -- refusing to scaffold; nothing was written"]+        <> concatMap renderHoleDrift drifts     render (ImportCycle path) =       [ "error: generated/consumer import cycle -- refusing to scaffold; nothing was written",         "  " <> T.intercalate " -> " path,@@ -1664,6 +1719,9 @@     render (GeneratedNameInvariantViolation violations) =       ["error: generated Haskell name invariant violated -- refusing to scaffold; nothing was written"]         <> map ("  " <>) violations+    render (ProcessReactionRefusal reasons) =+      ["error: process reaction metadata cannot be derived -- refusing to scaffold; nothing was written"]+        <> map ("  " <>) reasons     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:"@@ -1832,11 +1890,13 @@     <> previousSpecNote     <> constraintSection     <> newHolesSection+    <> processReactionHoleSection     <> queryContractSection     <> queryContractMigrationSection     <> mappingDriftSection     <> renderSemanticImpactReport ((.semanticImpact) report)     <> renderRouterSelectionDrift ((.routerSelectionDrift) report)+    <> renderProcessReactionDrift ((.processReactionCoordinationDrift) report)     <> maybe [] renderProjectionMappedImpact ((.projectionMappedImpact) report)     <> renderGeneratedArtifactImpact ((.semanticImpact) report) ((.generatedArtifactImpact) report)     <> sourceLanguageDriftSection@@ -1891,6 +1951,13 @@       [ "  " <> (.moduleName) hole,         "    " <> (.signature) hole <> " (" <> obligationKindLabel ((.kind) hole) <> ")"       ]+    processReactionHoleSection =+      concatMap renderProcessReactionHoles ((.processReactionRows) report)+    renderProcessReactionHoles row = case (.holeObligations) row of+      [] -> []+      obligations ->+        ["process reaction holes: " <> (.processName) row]+          <> map ("  " <>) obligations     queryContractSection =       [ "query contract history: baseline unavailable in the previous ledger; no legacy `()` API was inferred"       | (.queryContractBaselineUnavailable) report
src/Keiro/Dsl/SemanticImpact.hs view
@@ -401,7 +401,7 @@             useSite = site,             declaration = declaration           }-      | site@(RootEventField aggregate _ _ declaration) <- (.useSites) graph,+      | site@UseSite {root = RootEventField aggregate _ _, mappedKey = declaration} <- (.useSites) graph,         aggregate == derivedAuthority consumer       ]     aggregateDeclarations =@@ -428,7 +428,7 @@         (\_ paths -> Set.fromList (concatMap evidenceForPath paths))         pathsByDeclaration     evidenceForPath usePath =-      let directRoot = mappedRootFromUseSite ((.root) usePath)+      let directRoot = mappedRootFromUsePath graph usePath           direct =             MappedRootEvidence               { consumer = (.consumer) directRoot,@@ -520,7 +520,7 @@   where     queryInputEvidence =       [ selectionEvidence router SelectionQueryInput MappedRouterSelectionQueryInputRoot site ("router " <> router <> " selection query input")-      | site@RootReadModelQueryInput {} <- (.useSites) selection+      | site@UseSite {root = RootReadModelQueryInput {}} <- (.useSites) selection       ]     expressionEvidence =       checkedExpressionEvidence router selection SelectionPredicate MappedRouterSelectionPredicateRoot "predicate" ((.predicate) selection)@@ -554,7 +554,7 @@ selectionRootSites root selection =   [ site   | site <- (.useSites) selection,-    case (root, site) of+    case (root, (.root) site) of       (SelectionInput, RootReadModelQueryInput {}) -> True       (SelectionRow, RootReadModelQueryResult {}) -> True       _ -> False@@ -566,6 +566,7 @@   CheckedTextLiteral _ -> []   CheckedIntegralLiteral _ -> []   CheckedBoolLiteral _ -> []+  CheckedIdLiteral _ _ -> []   CheckedCompare _ left right -> checkedScalarPaths left <> checkedScalarPaths right   CheckedAnd left right -> checkedScalarPaths left <> checkedScalarPaths right   CheckedOr left right -> checkedScalarPaths left <> checkedScalarPaths right@@ -580,13 +581,7 @@       | otherwise = " as '" <> (.wireKey) segment <> "'"  useSiteDeclaration :: UseSite -> MappedKey-useSiteDeclaration = \case-  RootCommandField _ _ _ declaration -> declaration-  RootEventField _ _ _ declaration -> declaration-  RootRegister _ _ declaration -> declaration-  RootWorkqueueField _ _ declaration -> declaration-  RootReadModelQueryInput _ declaration -> declaration-  RootReadModelQueryResult _ declaration -> declaration+useSiteDeclaration = (.mappedKey)  consequencesForMappedEvidence :: TypeGraph -> MappedRootEvidence -> Set MappedConsequence consequencesForMappedEvidence graph evidence =@@ -876,51 +871,58 @@   Set.insert root (Map.findWithDefault Set.empty root ((.reachability) graph))  mappedRootFromUseSite :: UseSite -> MappedRoot-mappedRootFromUseSite site@(RootCommandField aggregate _ _ declaration) =+mappedRootFromUseSite site@UseSite {root = RootCommandField aggregate _ _, mappedKey = declaration} =   MappedRoot     { consumer = AggregateConsumer aggregate,       kind = MappedCommandFieldRoot,       useSite = site,       declaration = declaration     }-mappedRootFromUseSite site@(RootEventField aggregate _ _ declaration) =+mappedRootFromUseSite site@UseSite {root = RootEventField aggregate _ _, mappedKey = declaration} =   MappedRoot     { consumer = AggregateConsumer aggregate,       kind = MappedEventFieldRoot,       useSite = site,       declaration = declaration     }-mappedRootFromUseSite site@(RootRegister aggregate _ declaration) =+mappedRootFromUseSite site@UseSite {root = RootRegister aggregate _, mappedKey = declaration} =   MappedRoot     { consumer = AggregateConsumer aggregate,       kind = MappedRegisterRoot,       useSite = site,       declaration = declaration     }-mappedRootFromUseSite site@(RootWorkqueueField workqueue _ declaration) =+mappedRootFromUseSite site@UseSite {root = RootWorkqueueField workqueue _, mappedKey = declaration} =   MappedRoot     { consumer = WorkqueueConsumer workqueue,       kind = MappedWorkqueueFieldRoot,       useSite = site,       declaration = declaration     }-mappedRootFromUseSite site@(RootReadModelQueryInput readModel declaration) =+mappedRootFromUseSite site@UseSite {root = RootReadModelQueryInput readModel, mappedKey = declaration} =   MappedRoot     { consumer = ReadModelQueryConsumer readModel MappedQueryInput,       kind = MappedReadModelQueryInputRoot,       useSite = site,       declaration = declaration     }-mappedRootFromUseSite site@(RootReadModelQueryResult readModel declaration) =+mappedRootFromUseSite site@UseSite {root = RootReadModelQueryResult readModel, mappedKey = declaration} =   MappedRoot     { consumer = ReadModelQueryConsumer readModel MappedQueryResult,       kind = MappedReadModelQueryResultRoot,       useSite = site,       declaration = declaration     }+mappedRootFromUseSite UseSite {root = RootContractField {}} =+  error "contract declared IDs are nominal roots, never mapped use sites"  eventAuthority :: UsePath -> Maybe Name-eventAuthority UsePath {root = RootEventField aggregate _ _ _} = Just aggregate+mappedRootFromUsePath :: TypeGraph -> UsePath -> MappedRoot+mappedRootFromUsePath graph path =+  case [site | site <- (.useSites) graph, (.root) site == (.root) path] of+    site : _ -> mappedRootFromUseSite site+    [] -> error ("keiro-dsl internal invariant: use path has no mapped root site: " <> T.unpack (renderUsePath path))+eventAuthority UsePath {root = RootEventField aggregate _ _} = Just aggregate eventAuthority _ = Nothing  maybeToList :: Maybe value -> [value]
src/Keiro/Dsl/ServiceHarness.hs view
@@ -14,7 +14,7 @@ import Data.Text (Text) import Data.Text qualified as T import Keiro.Dsl.Grammar-import Keiro.Dsl.Harness (processHarnessFactValues, routerHarnessFactValuesForService, workflowHarnessFactValues)+import Keiro.Dsl.Harness (processHarnessFactValuesForService, 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, EffectiveLanguageContract (..), checkedLanguageContract, checkedSpec, checkedTypeGraph)@@ -203,7 +203,7 @@   where     (kindName, nodeName, _) = nodeIdentity node     factValues = case node of-      NProcess process -> processHarnessFactValues process+      NProcess process -> processHarnessFactValuesForService service process       NRouter router -> routerHarnessFactValuesForService service router       NWorkflow workflow -> workflowHarnessFactValues workflow       _ -> []
src/Keiro/Dsl/Skeleton.hs view
@@ -15,7 +15,7 @@  import Data.Text (Text) import Data.Text qualified as T-import Keiro.Dsl.LanguageVersion (currentAuthoringLanguageVersion, languageVersionText)+import Keiro.Dsl.LanguageVersion (currentStableLanguageVersion, languageVersionText)  -- | The valid @new \<kind\>@ arguments, in help/listing order. skeletonKinds :: [Text]@@ -52,7 +52,7 @@     Left $       "unknown kind '" <> other <> "'. Valid kinds: " <> T.intercalate ", " skeletonKinds   where-    versioned source = "language keiro-dsl " <> languageVersionText currentAuthoringLanguageVersion <> "\n" <> source+    versioned source = "language keiro-dsl " <> languageVersionText currentStableLanguageVersion <> "\n" <> source  aggregateSkeleton :: Text aggregateSkeleton =@@ -81,55 +81,52 @@   T.unlines     [ "context my-service",       "",-      "id  HospitalId  prefix=hosp",-      "id  CommandId   prefix=cmd",+      "id IncidentId prefix=inc",       "",-      "process HospitalSurge",-      "  name \"hospital-surge\"",-      "  input SurgeInput { hospitalId availableIcuBeds:Int redDemand:Int observedAt:Time }",-      "  correlate input.hospitalId via idText",-      "  saga Surge category \"hospitalSurge\"",-      "  target Hospital",+      "process IncidentProcess",+      "  name \"incident-process\"",+      "  input IncidentInput { incidentId:IncidentId observedAt:Time }",+      "  correlate input.incidentId via idText",+      "  saga IncidentSaga category \"incidentSaga\"",+      "  target Incident",       "  projections [ ]",       "",-      "  on SurgeInput",-      "    advance NoteSurgeThreshold { hospitalId availableIcuBeds redDemand timerId=timer.id }",-      "    dispatch Hospital@input.hospitalId ActivateSurge { hospitalId }",+      "  on IncidentInput",+      "    advance NoteIncident { incidentId timerId=timer.id }",+      "    dispatch Incident@input.incidentId AcknowledgeIncident { incidentId }",       "      on-appended AckOk ; on-duplicate AckOk ; on-failed Retry",-      "    schedule surgeFollowUp",+      "    schedule followUp",       "",       "  dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)",       "  rejected => halt",       "  poison => halt",       "",-      "  timer surgeFollowUp",-      "    id uuidv5 \"hospital-surge-timer:\" <> correlationId",+      "  timer followUp",+      "    id uuidv5 \"incident-follow-up-timer:\" <> correlationId",       "    fireAt input.observedAt + 5m",-      "    payload { kind=\"hospital-surge-follow-up\" hospitalId }",-      "    fire dispatch Surge@correlationId MarkSurgeTimerFired { hospitalId timerId }",-      "      fired-event-id uuidv5 \"hospital-surge-fired:\" <> correlationId",+      "    payload { kind=\"incident-follow-up\" incidentId }",+      "    fire dispatch IncidentSaga@correlationId MarkTimerFired { incidentId timerId }",+      "      fired-event-id uuidv5 \"incident-follow-up-fired:\" <> correlationId",       "      on-ok Fired ; on-reject Fired ; on-ambiguous Retry ; on-error Retry ; not-mine Retry",       "    decode unknown-status => Cancelled",-      "    max-attempts 5 dead-letter \"surge timer exceeded ceiling\"",+      "    max-attempts 5 dead-letter \"incident follow-up exceeded ceiling\"",       "",-      "aggregate Surge",+      "aggregate IncidentSaga",       "  regs",-      "  states Idle Fired!",-      "",-      "  command NoteSurgeThreshold { hospitalId availableIcuBeds:Int redDemand:Int timerId }",-      "  command MarkSurgeTimerFired { hospitalId timerId }",-      "  event SurgeThresholdNoted = fields(NoteSurgeThreshold)",-      "  event SurgeTimerMarked = fields(MarkSurgeTimerFired)",-      "  Idle -- NoteSurgeThreshold --> emit SurgeThresholdNoted ; goto Idle",-      "  Idle -- MarkSurgeTimerFired --> emit SurgeTimerMarked ; goto Fired",+      "  states Open",+      "  command NoteIncident { incidentId timerId }",+      "  command MarkTimerFired { incidentId timerId }",+      "  event IncidentNoted = fields(NoteIncident)",+      "  event TimerMarked = fields(MarkTimerFired)",+      "  Open -- NoteIncident --> emit IncidentNoted ; goto Open",+      "  Open -- MarkTimerFired --> emit TimerMarked ; goto Open",       "",-      "aggregate Hospital",+      "aggregate Incident",       "  regs",-      "  states Operational Surging!",-      "",-      "  command ActivateSurge { hospitalId }",-      "  event SurgeActivated = fields(ActivateSurge)",-      "  Operational -- ActivateSurge --> emit SurgeActivated ; goto Surging"+      "  states Open",+      "  command AcknowledgeIncident { incidentId }",+      "  event IncidentAcknowledged = fields(AcknowledgeIncident)",+      "  Open -- AcknowledgeIncident --> emit IncidentAcknowledged ; goto Open"     ]  routerSkeleton :: Text
src/Keiro/Dsl/SourceIndex.hs view
@@ -23,6 +23,7 @@ where  import Data.List (find, sort)+import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set qualified as Set@@ -33,6 +34,11 @@     Loc (..),     Name,     Node (..),+    ProcessBody (..),+    ProcessNode (..),+    ReactionArm (..),+    ReactionBody (..),+    ReactionNode (..),     Spec (..),     StateDecl (..),     Transition (..),@@ -47,6 +53,7 @@ data SourceSubject   = AggregateStateSubject !Name !Name   | AggregateTransitionSubject !Name !TransitionOrdinal+  | ProcessReactionSubject !Name !Name !Int   deriving stock (Eq, Ord, Show, Generic)  -- | Whether a position came from exact parsing or from a compatibility@@ -92,9 +99,10 @@ -- | The complete aggregate state and transition subject inventory of a -- semantic graph, in semantic source order. semanticSourceSubjects :: Spec -> [SourceSubject]-semanticSourceSubjects spec = concatMap aggregateSubjects aggregates+semanticSourceSubjects spec = concatMap aggregateSubjects aggregates <> concatMap processSubjects processes   where     aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]+    processes = [process | NProcess process <- (.nodes) spec]     aggregateSubjects aggregate =       [ AggregateStateSubject ((.name) aggregate) ((.name) state)       | state <- (.states) aggregate@@ -102,7 +110,26 @@         <> [ AggregateTransitionSubject ((.name) aggregate) (TransitionOrdinal ordinal)            | (ordinal, _) <- zip [0 ..] ((.transitions) aggregate)            ]+    processSubjects :: ProcessNode -> [SourceSubject]+    processSubjects process = case (.body) process of+      LegacyProcessBody {} -> []+      ReactionProcessBody reaction ->+        [ ProcessReactionSubject ((.id) process) inputName ordinal+        | (inputName, ordinal, _) <- numberedReactionArms reaction+        ] +numberedReactionArms :: ReactionBody -> [(Name, Int, ReactionArm)]+numberedReactionArms reaction =+  [ (inputName, length [() | (priorName, _) <- take index raw, priorName == inputName], arm)+  | (index, (inputName, arm)) <- zip [0 ..] raw+  ]+  where+    raw =+      [ ((.on) reactionNode, arm)+      | reactionNode <- NE.toList ((.reactions) reaction),+        arm <- NE.toList ((.arms) reactionNode)+      ]+ -- | Construct a complete exact index for one parsed file. The expected -- inventory comes from the just-lowered semantic graph, so missing and stale -- surface anchors are refused at the lowering boundary.@@ -133,7 +160,9 @@   checkedIndex CompatibilityLineOnly expected entries   where     expected = semanticSourceSubjects spec-    entries = concatMap aggregateEntries [aggregate | NAggregate aggregate <- (.nodes) spec]+    entries =+      concatMap aggregateEntries [aggregate | NAggregate aggregate <- (.nodes) spec]+        <> concatMap processEntries [process | NProcess process <- (.nodes) spec]     aggregateEntries aggregate =       [ (AggregateStateSubject ((.name) aggregate) ((.name) state), lineSpan ((.loc) state))       | state <- (.states) aggregate@@ -149,6 +178,13 @@         }       where         point = SourcePoint {offset = 0, line = max 1 lineNumber, column = 1}+    processEntries :: ProcessNode -> [(SourceSubject, SourceSpan)]+    processEntries process = case (.body) process of+      LegacyProcessBody {} -> []+      ReactionProcessBody reaction ->+        [ (ProcessReactionSubject ((.id) process) inputName ordinal, lineSpan ((.loc) arm))+        | (inputName, ordinal, arm) <- numberedReactionArms reaction+        ]  -- | Replace the one source name in an index after checking the caller's -- expected name. Workspace composition uses this to turn loader paths into
src/Keiro/Dsl/StructuralConformance.hs view
@@ -23,6 +23,7 @@     ScaffoldModule (..),     StructuralProjection (..),     generatedBanner,+    generatedNominalModule,     lowerFirst,     pascalFromKebab,     projectionSpecs,@@ -48,7 +49,9 @@ hasStructuralConformance :: CheckedService -> Bool hasStructuralConformance service = case checkedTypeGraph service of   Left _ -> False-  Right graph -> not (null (serviceMappedInventory (semanticImpact graph)))+  Right graph ->+    not (null (serviceMappedInventory (semanticImpact graph)))+      || not (null (conformanceNominalLeaves graph))  -- | Emit no module for an empty mapped inventory and exactly one generated -- module otherwise.@@ -58,11 +61,12 @@     Left failures -> Left [StructuralConformanceGraphFailure (T.pack (show failures))]     Right resolved -> Right resolved   let inventory = serviceMappedInventory (semanticImpact graph)+      nominalLeaves = conformanceNominalLeaves graph       missing = [key | key <- inventory, Map.notMember key ((.declarations) graph)]   case missing of     key : keys -> Left (map StructuralConformanceInventoryMissing (key : keys))-    [] -> case inventory of-      [] -> Right Nothing+    [] -> case (inventory, nominalLeaves) of+      ([], []) -> Right Nothing       _ ->         let rendering = conformanceRendering ctx graph inventory             moduleName = structuralConformanceModuleName ctx@@ -78,6 +82,7 @@   { context :: !Context,     graph :: !TypeGraph,     declarations :: ![ResolvedMappedDecl],+    nominals :: ![NominalLeaf],     projections :: ![StructuralProjection],     importPlan :: !HaskellImportPlan   }@@ -86,16 +91,40 @@ conformanceRendering ctx graph inventory = rendering   where     declarations = [declaration | key <- inventory, Just declaration <- [Map.lookup key ((.declarations) graph)]]+    nominals = conformanceNominalLeaves graph     projections = map (resolveProjectionModules ctx) (projectionSpecs graph)     rendering =       ConformanceRendering         { context = ctx,           graph = graph,           declarations = declarations,+          nominals = nominals,           projections = projections,-          importPlan = conformanceImportPlan ctx declarations projections+          importPlan = conformanceImportPlan ctx graph declarations nominals projections         } +conformanceNominalLeaves :: TypeGraph -> [NominalLeaf]+conformanceNominalLeaves graph =+  [ leaf+  | name <- Set.toAscList names,+    Just leaf <- [Map.lookup name ((.nominalLeaves) graph)]+  ]+  where+    names =+      Set.unions (Map.elems ((.nominalReachability) graph))+        <> Set.fromList+          [ (.nominal) site+          | site <- (.nominalRootSites) graph,+            case (.root) site of+              RootWorkqueueField {} -> True+              RootReadModelQueryInput {} -> True+              RootReadModelQueryResult {} -> True+              RootContractField {} -> True+              RootCommandField {} -> False+              RootEventField {} -> False+              RootRegister {} -> False+          ]+ renderStructuralConformance :: ConformanceRendering -> Text renderStructuralConformance rendering =   T.unlines $@@ -108,27 +137,41 @@       <> conformanceImports rendering       <> [ "",            "structuralConformanceAssertions :: [(String, Bool)]",-           "structuralConformanceAssertions =",-           "  concat",-           "    [ " <> T.intercalate "\n    , " assertionLists,-           "    ]",-           "",-           "validFixtureLabels :: NonEmpty.NonEmpty (T.Text, value) -> Bool",-           "validFixtureLabels cases =",-           "  all (not . T.null) labels && length labels == length (nub labels)",-           "  where",-           "    labels = map fst (NonEmpty.toList cases)"+           "structuralConformanceAssertions ="          ]+      <> case assertionLists of+        [] -> ["  []"]+        _ ->+          [ "  concat",+            "    [ " <> T.intercalate "\n    , " assertionLists,+            "    ]"+          ]+      <> ( if not (null structural) || not (null opaque)+             then+               [ "",+                 "validFixtureLabels :: NonEmpty.NonEmpty (T.Text, value) -> Bool",+                 "validFixtureLabels cases =",+                 "  all (not . T.null) labels && length labels == length (nub labels)",+                 "  where",+                 "    labels = map fst (NonEmpty.toList cases)"+               ]+             else []+         )       <> concatMap (bindingAssertionDecl rendering) structural+      <> concatMap (nominalAssertionDecl rendering) consumerNominals       <> concatMap (opaqueAssertionDecl rendering) opaque       <> concatMap (coverageDecl rendering) structural       <> projectionAssertionDecls rendering structural   where     structural = [(declaration, shape) | ResolvedStructural declaration shape <- (.declarations) rendering]     opaque = [declaration | ResolvedOpaque declaration <- (.declarations) rendering]+    consumerNominals = [leaf | leaf@NominalLeaf {ownership = ConsumerLeaf {}} <- (.nominals) rendering]+    generatedIdAssertions = structuralGeneratedIdAssertions rendering structural     assertionLists =       [lowerFirst ((.name) declaration) <> "BindingAssertions" | (declaration, _) <- structural]         <> [lowerFirst ((.name) declaration) <> "OpaqueAssertions" | declaration <- opaque]+        <> [lowerFirst ((.name) leaf) <> "NominalAssertions" | leaf <- consumerNominals]+        <> map (generatedIdAssertionList rendering) generatedIdAssertions         <> [ "[(\"fixture coverage: "                <> unCanonicalTypeId ((.canonical) declaration)                <> "\", coverage"@@ -140,14 +183,19 @@  conformanceImports :: ConformanceRendering -> [Text] conformanceImports rendering =-  ["import Data.Aeson qualified as Aeson" | not (null opaque)]-    <> ["import Data.List (nub)", "import Data.List.NonEmpty qualified as NonEmpty"]+  ["import Data.Aeson qualified as Aeson" | not (null opaque) || not (null generatedIdAssertions)]+    <> ["import Data.Aeson.Types qualified as AesonTypes" | not (null generatedIdAssertions)]+    <> ["import Data.List (nub)" | not (null structural) || not (null opaque)]+    <> ["import Data.List.NonEmpty qualified as NonEmpty" | not (null structural) || not (null opaque) || not (null consumerNominals)]+    <> ["import Data.Map.Strict qualified as Map" | any structuralUsesKeyedMap structural]+    <> ["import Data.KindID qualified as KindID" | any (nominalNeedsOrderingLaw rendering) consumerNominals]     <> ["import Data.Maybe (isJust, isNothing)" | any shapeUsesMaybe structural]-    <> ["import Data.Proxy (Proxy (..))" | not (null structural)]-    <> ["import Data.Text qualified as T"]+    <> ["import Data.Proxy (Proxy (..))" | not (null structural) || not (null consumerNominals)]+    <> ["import Data.Text qualified as T" | not (null structural) || not (null opaque)]     <> ["import Keiki.Core (fieldWitnessAgrees)" | not (null projections)]-    <> ["import Keiki.Shape (CanonicalTypeName (..))" | not (null structural)]-    <> ["import Keiro.Codec.Structural (" <> T.intercalate ", " structuralCodecImports <> ")"]+    <> ["import Keiki.Shape (CanonicalTypeName (..))" | not (null structural) || not (null consumerNominals)]+    <> ["import Keiro.Codec.Nominal (nominalDomainRoundTrip, nominalFixtureCases, nominalFixtureDomain, nominalRepresentationRoundTrip, nominalToRepresentation)" | not (null consumerNominals)]+    <> ["import Keiro.Codec.Structural (" <> T.intercalate ", " structuralCodecImports <> ")" | not (null structural) || not (null opaque)]     <> [ "import " <> structuralProjectionModuleName ((.context) rendering) <> " qualified as StructuralProjections"        | not (null projections)        ]@@ -157,6 +205,8 @@     declarations = (.declarations) rendering     structural = [(declaration, shape) | ResolvedStructural declaration shape <- declarations]     opaque = [declaration | ResolvedOpaque declaration <- declarations]+    consumerNominals = [leaf | leaf@NominalLeaf {ownership = ConsumerLeaf {}} <- (.nominals) rendering]+    generatedIdAssertions = structuralGeneratedIdAssertions rendering structural     projections = (.projections) rendering     fieldScopeImports =       [ "import " <> shapeModule <> " (" <> lastSegment shapeModule <> "Shape(" <> T.intercalate ", " (Set.toAscList selectors) <> "))"@@ -165,16 +215,11 @@     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-               ]-        )+        [ (structuralShapeModuleName ((.context) rendering) ((.name) declaration), Set.singleton ((.haskell) field))+        | (declaration, RRecord _ _ fields) <- structural,+          field <- fields,+          isOptional ((.valueType) field)+        ]     structuralCodecImports =       ["FixtureCases (..)"]         <> if null structural then [] else ["bindingDomainRoundTrip", "bindingShapeRoundTrip", "bindingToShape"]@@ -184,12 +229,22 @@       REnum {} -> False     isOptional ROptional {} = True     isOptional _ = False+    structuralUsesKeyedMap (_, shape) = any typeUsesKeyedMap (shapeExpressions shape)+    shapeExpressions (RRecord _ _ fields) = map (.valueType) fields+    shapeExpressions (RUnion _ arms) = [payload | arm <- arms, payload <- maybe [] pure ((.payload) arm)]+    shapeExpressions REnum {} = []+    typeUsesKeyedMap = \case+      ROptional item -> typeUsesKeyedMap item+      RList item -> typeUsesKeyedMap item+      RMap item -> typeUsesKeyedMap item+      RKeyedMap {} -> True+      _ -> False  lastSegment :: Text -> Text lastSegment = last . T.splitOn "." -conformanceImportPlan :: Context -> [ResolvedMappedDecl] -> [StructuralProjection] -> HaskellImportPlan-conformanceImportPlan ctx declarations _projections =+conformanceImportPlan :: Context -> TypeGraph -> [ResolvedMappedDecl] -> [NominalLeaf] -> [StructuralProjection] -> HaskellImportPlan+conformanceImportPlan ctx graph declarations nominals _projections =   either     (error . ("validated structural conformance import planning failed: " <>) . show)     id@@ -218,7 +273,47 @@         | ResolvedStructural declaration shape <- declarations,           reference <- structuralShapeReferences ctx declaration shape         ]-    references = declarationReferences <> shapeReferences+    generatedShapeReferences =+      Set.fromList+        [ HaskellReference (structuralShapeModuleName ctx ((.name) declaration)) constructor ConstructorNamespace RequireQualified+        | ResolvedStructural declaration (RRecord constructor _ _) <- declarations,+          not . Set.null $+            Set.intersection+              generatedIdNames+              (Map.findWithDefault Set.empty (MappedKey ((.name) declaration)) ((.nominalReachability) graph))+        ]+    nominalReferences =+      Set.fromList+        [ reference+        | NominalLeaf {ownership = ConsumerLeaf binding} <- nominals,+          reference <-+            conformanceTypeReference ((.haskell) binding)+              : map conformanceQualifiedValueReference [(.binding) binding, (.fixtures) binding]+        ]+    generatedNominalReferences =+      Set.fromList+        [ reference+        | leaf@NominalLeaf {kind = NominalIdLeaf {}, ownership = GeneratedLeaf} <- nominals,+          Set.member ((.name) leaf) structuralNominalNames,+          occurrence <- ["encode" <> (.name) leaf <> "Leaf", "parse" <> (.name) leaf <> "Leaf"],+          let reference = HaskellReference (contextStructuralPrefix ctx <> ".Structural.NominalLeaves") occurrence ValueNamespace RequireQualified+        ]+        <> Set.fromList+          [ HaskellReference (generatedNominalModule ctx) (lowerFirst ((.name) leaf) <> "Text") ValueNamespace RequireQualified+          | leaf@NominalLeaf {kind = NominalIdLeaf {}, ownership = GeneratedLeaf} <- nominals,+            Set.member ((.name) leaf) structuralNominalNames+          ]+    structuralNominalNames =+      Set.unions+        [ Map.findWithDefault Set.empty (MappedKey ((.name) declaration)) ((.nominalReachability) graph)+        | ResolvedStructural declaration _ <- declarations+        ]+    generatedIdNames =+      Set.fromList+        [ (.name) leaf+        | leaf@NominalLeaf {kind = NominalIdLeaf {}, ownership = GeneratedLeaf} <- nominals+        ]+    references = declarationReferences <> shapeReferences <> generatedShapeReferences <> nominalReferences <> generatedNominalReferences  conformanceTypeReference :: HaskellSource -> HaskellReference conformanceTypeReference source =@@ -277,6 +372,178 @@     binding = renderReference rendering (conformanceQualifiedValueReference ((.binding) declaration))     fixtures = renderReference rendering (conformanceQualifiedValueReference ((.fixtures) declaration)) +nominalAssertionDecl :: ConformanceRendering -> NominalLeaf -> [Text]+nominalAssertionDecl rendering leaf = case (.ownership) leaf of+  GeneratedLeaf -> []+  ConsumerLeaf binding ->+    [ "",+      valueName <> " :: [(String, Bool)]",+      valueName <> " =",+      "  [ (\"nominal domain law: " <> name <> "\", all (nominalDomainRoundTrip " <> bindingName <> " . nominalFixtureDomain) cases)",+      "  , (\"nominal representation law: " <> name <> "\", all (\\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip " <> bindingName <> " (nominalToRepresentation " <> bindingName <> " domainValue)) cases)",+      "  , (\"nominal canonical identity: " <> name <> "\", canonicalTypeName (Proxy @" <> consumerType <> ") == " <> tshow canonical <> ")"+    ]+      <> [ "  , (\"nominal key ordering: " <> name <> "\", and [compare left right == compare (KindID.toText (nominalToRepresentation " <> bindingName <> " left)) (KindID.toText (nominalToRepresentation " <> bindingName <> " right)) | left <- domainValues, right <- domainValues])"+         | nominalNeedsOrderingLaw rendering leaf+         ]+      <> [ "  ]",+           "  where",+           "    cases = NonEmpty.toList (nominalFixtureCases " <> fixtures <> ")"+         ]+      <> ["    domainValues = map nominalFixtureDomain cases" | nominalNeedsOrderingLaw rendering leaf]+    where+      name = (.name) leaf+      valueName = lowerFirst name <> "NominalAssertions"+      consumerType = renderReference rendering (conformanceTypeReference ((.haskell) binding))+      bindingName = renderReference rendering (conformanceQualifiedValueReference ((.binding) binding))+      fixtures = renderReference rendering (conformanceQualifiedValueReference ((.fixtures) binding))+      canonical = unCanonicalTypeId ((.canonical) binding)++nominalNeedsOrderingLaw :: ConformanceRendering -> NominalLeaf -> Bool+nominalNeedsOrderingLaw rendering leaf =+  case ((.kind) leaf, (.ownership) leaf) of+    (NominalIdLeaf {}, ConsumerLeaf {}) ->+      any (elem SegMapKey . (.segments)) (nominalUsePaths ((.graph) rendering) ((.name) leaf))+    _ -> False++structuralGeneratedIdAssertions :: ConformanceRendering -> [(StructuralDecl, ResolvedMappedShape)] -> [(StructuralDecl, ResolvedMappedShape, NominalLeaf)]+structuralGeneratedIdAssertions rendering structural =+  [ (declaration, shape, leaf)+  | (declaration, shape) <- structural,+    nominalName <- Set.toAscList (Map.findWithDefault Set.empty (MappedKey ((.name) declaration)) ((.nominalReachability) ((.graph) rendering))),+    Just leaf@NominalLeaf {kind = NominalIdLeaf {}, ownership = GeneratedLeaf} <- [Map.lookup nominalName ((.nominalLeaves) ((.graph) rendering))]+  ]++generatedIdAssertionList :: ConformanceRendering -> (StructuralDecl, ResolvedMappedShape, NominalLeaf) -> Text+generatedIdAssertionList rendering (declaration, shape, leaf) =+  "[(\"generated nominal canonical text: "+    <> unCanonicalTypeId ((.canonical) declaration)+    <> "/"+    <> (.name) leaf+    <> "\", all (\\(_, value) -> "+    <> generatedIdShapeExpression rendering leaf declaration shape ("bindingToShape " <> binding <> " value") 0+    <> ") (NonEmpty.toList (fixtureCases "+    <> fixtures+    <> ")))]"+  where+    binding = renderReference rendering (conformanceQualifiedValueReference ((.binding) declaration))+    fixtures = renderReference rendering (conformanceQualifiedValueReference ((.fixtures) declaration))++generatedIdShapeExpression :: ConformanceRendering -> NominalLeaf -> StructuralDecl -> ResolvedMappedShape -> Text -> Int -> Text+generatedIdShapeExpression rendering target declaration shape candidate depth = case shape of+  RRecord constructor _ fields ->+    "(case "+      <> candidate+      <> " of "+      <> shapeConstructor rendering ((.name) declaration) constructor+      <> (if null variables then "" else " " <> T.unwords variables)+      <> " -> "+      <> conjunction+        [ generatedIdTypeExpression rendering target ((.valueType) field) variable (depth + 1)+        | (field, variable) <- zip fields variables,+          nominalOccursIn rendering target ((.valueType) field)+        ]+      <> ")"+    where+      variables =+        [ if nominalOccursIn rendering target ((.valueType) field)+            then "field" <> tshow depth <> "_" <> tshow index+            else "_"+        | (index, field) <- zip [0 :: Int ..] fields+        ]+  REnum _ -> "True"+  RUnion _ arms ->+    "(case " <> candidate <> " of " <> T.intercalate "; " (map renderArm arms) <> ")"+    where+      renderArm arm =+        shapeConstructor rendering ((.name) declaration) ((.ctor) arm)+          <> case (.payload) arm of+            Nothing -> " -> True"+            Just payload+              | nominalOccursIn rendering target payload ->+                  " payload" <> tshow depth <> " -> " <> generatedIdTypeExpression rendering target payload ("payload" <> tshow depth) (depth + 1)+              | otherwise -> " _ -> True"++generatedIdTypeExpression :: ConformanceRendering -> NominalLeaf -> ResolvedTypeExpr -> Text -> Int -> Text+generatedIdTypeExpression rendering target expression candidate depth = case expression of+  ROptional item -> "maybe True (\\item" <> tshow depth <> " -> " <> generatedIdTypeExpression rendering target item ("item" <> tshow depth) (depth + 1) <> ") " <> parenthesize candidate+  RList item -> "all (\\item" <> tshow depth <> " -> " <> generatedIdTypeExpression rendering target item ("item" <> tshow depth) (depth + 1) <> ") " <> parenthesize candidate+  RMap item -> "all (\\item" <> tshow depth <> " -> " <> generatedIdTypeExpression rendering target item ("item" <> tshow depth) (depth + 1) <> ") " <> parenthesize candidate+  RKeyedMap key item ->+    conjunction $+      [ "all (\\key"+          <> tshow depth+          <> " -> "+          <> generatedIdTypeExpression rendering target (RNominal key) ("key" <> tshow depth) (depth + 1)+          <> ") (Map.keys "+          <> parenthesize candidate+          <> ")"+      | (.name) key == (.name) target+      ]+        <> [ "all (\\item"+               <> tshow depth+               <> " -> "+               <> generatedIdTypeExpression rendering target item ("item" <> tshow depth) (depth + 1)+               <> ") "+               <> parenthesize candidate+           | nominalOccursIn rendering target item+           ]+  RRef key -> case Map.lookup key ((.declarations) ((.graph) rendering)) of+    Just (ResolvedStructural declaration shape) -> generatedIdShapeExpression rendering target declaration shape candidate depth+    _ -> "True"+  RNominal leaf+    | (.name) leaf == (.name) target ->+        let encoded = nominalHelper rendering "encode" target <> " " <> parenthesize candidate+         in "("+              <> encoded+              <> " == Aeson.String ("+              <> generatedNominalText rendering target+              <> " "+              <> parenthesize candidate+              <> ") && AesonTypes.parseEither "+              <> nominalHelper rendering "parse" target+              <> " ("+              <> encoded+              <> ") == Right "+              <> parenthesize candidate+              <> ")"+  _ -> "True"++nominalOccursIn :: ConformanceRendering -> NominalLeaf -> ResolvedTypeExpr -> Bool+nominalOccursIn rendering target = \case+  ROptional item -> nominalOccursIn rendering target item+  RList item -> nominalOccursIn rendering target item+  RMap item -> nominalOccursIn rendering target item+  RKeyedMap key item -> (.name) key == (.name) target || nominalOccursIn rendering target item+  RRef key -> Set.member ((.name) target) (Map.findWithDefault Set.empty key ((.nominalReachability) ((.graph) rendering)))+  RNominal leaf -> (.name) leaf == (.name) target+  _ -> False++shapeConstructor :: ConformanceRendering -> Name -> Name -> Text+shapeConstructor rendering declarationName constructor =+  renderReference+    rendering+    (HaskellReference (structuralShapeModuleName ((.context) rendering) declarationName) constructor ConstructorNamespace RequireQualified)++nominalHelper :: ConformanceRendering -> Text -> NominalLeaf -> Text+nominalHelper rendering prefix leaf =+  renderReference+    rendering+    (HaskellReference (contextStructuralPrefix ((.context) rendering) <> ".Structural.NominalLeaves") (prefix <> (.name) leaf <> "Leaf") ValueNamespace RequireQualified)++generatedNominalText :: ConformanceRendering -> NominalLeaf -> Text+generatedNominalText rendering leaf =+  renderReference+    rendering+    (HaskellReference (generatedNominalModule ((.context) rendering)) (lowerFirst ((.name) leaf) <> "Text") ValueNamespace RequireQualified)++conjunction :: [Text] -> Text+conjunction [] = "True"+conjunction expressions = T.intercalate " && " (map parenthesize expressions)++parenthesize :: Text -> Text+parenthesize value = "(" <> value <> ")"+ opaqueAssertionDecl :: ConformanceRendering -> OpaqueDecl -> [Text] opaqueAssertionDecl rendering declaration =   [ "",@@ -323,6 +590,10 @@     [ "any (isNothing . " <> selector <> ") shapes",       "any (isJust . " <> selector <> ") shapes"     ]+  -- A nominal enum's own NominalFixtureCases prove every representation arm.+  -- Requiring each enclosing structural fixture set to repeat those arms adds+  -- no new binding evidence and scales fixture burden with every embedding.+  RNominal NominalLeaf {kind = NominalEnumLeaf {}} -> []   _ -> []   where     selector = "(." <> (.haskell) field <> ")"@@ -368,16 +639,8 @@       Nothing -> "error \"projection owner fixtures missing\""  projectionGetter :: ConformanceRendering -> Text -> StructuralProjection -> Text-projectionGetter rendering owner spec =-  foldl-    ( \value (_shapeModule, selector) ->-        "("-          <> value-          <> ")."-          <> selector-    )-    ("bindingToShape " <> renderReference rendering (conformanceQualifiedValueReference ((.binding) spec)) <> " " <> owner)-    ((.selectors) spec)+projectionGetter _rendering owner spec =+  "StructuralProjections." <> (.getter) spec <> " " <> owner  structuralShapeModuleName :: Context -> Name -> Text structuralShapeModuleName ctx name = case (.placement) ctx of
src/Keiro/Dsl/Syntax.hs view
@@ -67,4 +67,5 @@   | SurfaceExpression !Expr   | SurfaceAggregateState !Name !Name   | SurfaceAggregateTransition !Name !Int+  | SurfaceProcessReaction !Name !Name !Int   deriving stock (Eq, Show, Generic)
+ src/Keiro/Dsl/TransitionFamily.hs view
@@ -0,0 +1,271 @@+-- | Deterministic, declaration-order-independent transition family comparison.+module Keiro.Dsl.TransitionFamily+  ( TransitionFamilyKey (..),+    TransitionFamilyDelta (..),+    ReplayBodyKey (..),+    ReplayBodyStatus (..),+    ReplayBodyDelta (..),+    transitionFamilyDeltas,+    replayBodyKey,+    replayBodyDeltas,+    guardAlternatives,+    guardUnion,+    guardImplies,+    unionPreserved,+  )+where++import Data.List (sortOn)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Set qualified as Set+import Data.Text (Text)+import Keiro.Dsl.CanonicalEncoding (canonicalExpr, canonicalTransition)+import Keiro.Dsl.Grammar+  ( Atom (..),+    Expr (..),+    Name,+    ScalarLiteral (..),+    Transition (..),+    TransitionMode (..),+    complementExpr,+    noLoc,+  )++-- | The structural identity shared by ordinary diff and replay-impact analysis.+data TransitionFamilyKey = TransitionFamilyKey+  { familyMode :: !TransitionMode,+    familySource :: !Name,+    familyCommand :: !Name+  }+  deriving stock (Eq, Show)++instance Ord TransitionFamilyKey where+  compare left right =+    compare+      (modeRank ((.familyMode) left), (.familySource) left, (.familyCommand) left)+      (modeRank ((.familyMode) right), (.familySource) right, (.familyCommand) right)++-- | The exact old and new remainders after duplicate-aware cancellation.+data TransitionFamilyDelta = TransitionFamilyDelta+  { familyKey :: !TransitionFamilyKey,+    oldRemainder :: ![Transition],+    newRemainder :: ![Transition]+  }+  deriving stock (Eq, Show)++-- | Frozen replay behavior within one family, excluding guard, mode, location,+-- and forward-only outcomes.+newtype ReplayBodyKey = ReplayBodyKey {unReplayBodyKey :: Text}+  deriving stock (Eq, Ord, Show)++-- | Directional classification of the complete old and new guard unions for+-- one replay body.+data ReplayBodyStatus+  = ReplayBodyPreserved+  | ReplayBodyChanged+  | ReplayBodyRemoved+  | ReplayBodyAdded+  deriving stock (Eq, Ord, Show)++-- | One affected replay body. Presence is represented by the member lists;+-- within a present body, an absent guard means the Boolean constant true.+data ReplayBodyDelta = ReplayBodyDelta+  { bodyFamilyKey :: !TransitionFamilyKey,+    bodyKey :: !ReplayBodyKey,+    oldBodyMembers :: ![Transition],+    newBodyMembers :: ![Transition],+    bodyStatus :: !ReplayBodyStatus+  }+  deriving stock (Eq, Show)++-- | Partition transitions into ordered families and cancel exact canonical+-- matches as a multiset. Fully cancelled families remain in the result.+transitionFamilyDeltas :: [Transition] -> [Transition] -> [TransitionFamilyDelta]+transitionFamilyDeltas oldTransitions newTransitions =+  [ let (oldRemainder, newRemainder) =+          cancelExact+            (Map.findWithDefault [] key oldFamilies)+            (Map.findWithDefault [] key newFamilies)+     in TransitionFamilyDelta {familyKey = key, oldRemainder, newRemainder}+  | key <- Set.toAscList (Map.keysSet oldFamilies <> Map.keysSet newFamilies)+  ]+  where+    oldFamilies = transitionFamilies oldTransitions+    newFamilies = transitionFamilies newTransitions++-- | Classify complete guard unions for replay bodies selected by an emitting+-- exact remainder. Cancelled siblings remain members of the recovered body.+replayBodyDeltas :: [Transition] -> [Transition] -> [ReplayBodyDelta]+replayBodyDeltas oldTransitions newTransitions =+  concatMap classifyFamily (transitionFamilyDeltas oldTransitions newTransitions)+  where+    oldFamilies = transitionFamilies oldTransitions+    newFamilies = transitionFamilies newTransitions++    classifyFamily familyDelta =+      [ let oldMembers = membersFor key body oldFamilies+            newMembers = membersFor key body newFamilies+         in ReplayBodyDelta+              { bodyFamilyKey = key,+                bodyKey = body,+                oldBodyMembers = oldMembers,+                newBodyMembers = newMembers,+                bodyStatus = classifyBody oldMembers newMembers+              }+      | body <- affectedBodies familyDelta+      ]+      where+        key = (.familyKey) familyDelta++    affectedBodies familyDelta =+      Set.toAscList . Set.fromList $+        [ replayBodyKey transition+        | transition <- (.oldRemainder) familyDelta <> (.newRemainder) familyDelta,+          not (null transition.emits)+        ]++    membersFor family body families =+      sortOn+        canonicalTransition+        [ transition+        | transition <- Map.findWithDefault [] family families,+          replayBodyKey transition == body+        ]++    classifyBody [] (_ : _) = ReplayBodyAdded+    classifyBody (_ : _) [] = ReplayBodyRemoved+    classifyBody oldMembers newMembers+      | Just oldGuards <- NE.nonEmpty (map (.guard) oldMembers),+        Just newGuards <- NE.nonEmpty (map (.guard) newMembers),+        unionPreserved oldGuards newGuards =+          ReplayBodyPreserved+      | otherwise = ReplayBodyChanged++-- | Derive a body key through the frozen transition encoding rather than a+-- second expression or transition renderer.+replayBodyKey :: Transition -> ReplayBodyKey+replayBodyKey transition =+  ReplayBodyKey . canonicalTransition $+    Transition+      { source = transition.source,+        command = transition.command,+        implementation = transition.implementation,+        guard = Nothing,+        writes = transition.writes,+        emits = transition.emits,+        outcome = Nothing,+        outcomeDuplicateLocs = [],+        goto = transition.goto,+        mode = TmLive,+        loc = noLoc+      }++-- | Canonical, comparison-local alternatives for a present guard union.+-- 'Nothing' represents true and absorbs every other alternative.+guardAlternatives :: NonEmpty (Maybe Expr) -> NonEmpty (Maybe Expr)+guardAlternatives guards+  | any isTrueGuard guards = Nothing :| []+  | otherwise =+      case NE.nonEmpty (map Just normalized) of+        Just alternatives -> alternatives+        Nothing -> Nothing :| []+  where+    normalized =+      Map.elems . Map.fromList $+        [ (canonicalExpr alternative, alternative)+        | alternative <- concatMap (maybe [] flattenOr) (NE.toList guards)+        ]++    flattenOr (EOr left right) = flattenOr left <> flattenOr right+    flattenOr expression = [expression]++-- | Build the normalized union. The result is 'Nothing' exactly when the+-- union is true; explicit false remains an ordinary alternative.+guardUnion :: NonEmpty (Maybe Expr) -> Maybe Expr+guardUnion guards =+  case guardAlternatives guards of+    Nothing :| [] -> Nothing+    Just first :| rest -> Just (foldr1 EOr (first : mapMaybe id rest))+    _ -> Nothing++-- | Prove that every old alternative remains accepted by the new union.+unionPreserved :: NonEmpty (Maybe Expr) -> NonEmpty (Maybe Expr) -> Bool+unionPreserved oldGuards newGuards =+  canonicalUnion oldAlternatives == canonicalUnion newAlternatives+    || all (`guardImplies` newUnion) oldAlternatives+  where+    oldAlternatives = NE.toList (guardAlternatives oldGuards)+    newAlternatives = NE.toList (guardAlternatives newGuards)+    newUnion = guardUnion newGuards+    canonicalUnion = maybe "" canonicalExpr . guardUnion . NE.fromList++-- | A deliberately small implication fragment used by diff and replay impact.+-- Unknown shapes return false so analysis stays conservative.+guardImplies :: Maybe Expr -> Maybe Expr -> Bool+guardImplies _ Nothing = True+guardImplies Nothing (Just newGuard) = isTrueExpr newGuard+guardImplies (Just oldGuard) (Just newGuard) = implies oldGuard newGuard+  where+    implies old new+      | old == new = True+    implies old _ | isFalseExpr old = True+    implies _ new | isTrueExpr new = True+    implies (EAnd left right) new = implies left new || implies right new+    implies old (EOr (EAnd leftA rightA) (EAnd leftB rightB))+      | canonicalExpr leftA == canonicalExpr leftB =+          implies old leftA && implies old (EOr rightA rightB)+    implies _ (EOr left right) | complementary left right = True+    implies old (EOr left right) = implies old left || implies old right+    implies _ _ = False+    complementary left right =+      canonicalExpr (complementExpr left) == canonicalExpr right+        || canonicalExpr left == canonicalExpr (complementExpr right)++isTrueGuard :: Maybe Expr -> Bool+isTrueGuard Nothing = True+isTrueGuard (Just expression) = isTrueExpr expression++isTrueExpr :: Expr -> Bool+isTrueExpr (EAtom (ABool True)) = True+isTrueExpr (ELiteral _ (LiteralBool True)) = True+isTrueExpr _ = False++isFalseExpr :: Expr -> Bool+isFalseExpr (EAtom (ABool False)) = True+isFalseExpr (ELiteral _ (LiteralBool False)) = True+isFalseExpr _ = False++transitionFamilies :: [Transition] -> Map.Map TransitionFamilyKey [Transition]+transitionFamilies =+  Map.fromListWith (flip (<>))+    . map (\transition -> (transitionFamilyKey transition, [transition]))++transitionFamilyKey :: Transition -> TransitionFamilyKey+transitionFamilyKey transition =+  TransitionFamilyKey+    { familyMode = transition.mode,+      familySource = transition.source,+      familyCommand = transition.command+    }++modeRank :: TransitionMode -> Int+modeRank TmLive = 0+modeRank TmReplayOnly = 1++cancelExact :: [Transition] -> [Transition] -> ([Transition], [Transition])+cancelExact oldTransitions newTransitions = go sortedOld sortedNew [] []+  where+    sortedOld = sortOn canonicalTransition oldTransitions+    sortedNew = sortOn canonicalTransition newTransitions+    go [] remainingNew unmatchedOld unmatchedNew =+      (reverse unmatchedOld, reverse unmatchedNew <> remainingNew)+    go remainingOld [] unmatchedOld unmatchedNew =+      (reverse unmatchedOld <> remainingOld, reverse unmatchedNew)+    go old@(oldTransition : remainingOld) new@(newTransition : remainingNew) unmatchedOld unmatchedNew =+      case compare (canonicalTransition oldTransition) (canonicalTransition newTransition) of+        LT -> go remainingOld new (oldTransition : unmatchedOld) unmatchedNew+        EQ -> go remainingOld remainingNew unmatchedOld unmatchedNew+        GT -> go old remainingNew unmatchedOld (newTransition : unmatchedNew)
src/Keiro/Dsl/TypeGraph.hs view
@@ -20,6 +20,16 @@     mkBindingVersion,     mkCodecIdentity,     mkCodecVersion,+    NominalScalarRepresentation (..),+    ConsumerNominalBinding (..),+    NominalLeafKind (..),+    NominalLeafOwnership (..),+    NominalLeaf (..),+    NominalLeafIssue (..),+    NominalLeafError (..),+    checkIdLeaf,+    checkEnumLeaf,+    checkScalarLeaf,     MappedDeclError (..),     CheckedMappedDecl (..),     StructuralDecl (..),@@ -36,13 +46,16 @@     DerivedMappedConsumer (..),     UnsupportedProjectionSource (..),     TypeGraph (..),+    RootRef (..),     UseSite (..),+    NominalRootSite (..),     PathSeg (..),     UsePath (..),     resolveTypeGraph,     resolveTypeExpression,     useSiteSegments,     usePaths,+    nominalUsePaths,     renderUsePath,     TypeExprAlgebra (..),     foldTypeExpr,@@ -51,12 +64,13 @@     MappedDeclAlgebra (..),     foldMappedDecl,     wireFingerprint,+    nominalWireFingerprint,   ) where  import Data.Bifunctor (first) import Data.Bits (xor)-import Data.Char (ord)+import Data.Char (isAscii, isDigit, isLower, isUpper, ord) import Data.Either (partitionEithers) import Data.Graph (SCC (..), stronglyConnComp) import Data.List (sort, sortOn)@@ -64,14 +78,15 @@ import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Data.Maybe (catMaybes) import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T+import Data.TypeID qualified as TypeID import Data.Word (Word64) import GHC.Generics (Generic) import Keiro.Dsl.Grammar+import Keiro.Dsl.HaskellName (haskellKeywords) import Numeric (showHex)  newtype QualifiedValueName = QualifiedValueName {unQualifiedValueName :: Text}@@ -144,6 +159,163 @@   | T.null (T.strip value) = Left (EmptyCodecVersion value)   | otherwise = Right (CodecVersion value) +data NominalScalarRepresentation+  = NominalText+  | NominalInt+  | NominalNatural+  | NominalBool+  | NominalTime+  deriving stock (Eq, Ord, Show, Generic)++data ConsumerNominalBinding = ConsumerNominalBinding+  { haskell :: !HaskellSource,+    binding :: !QualifiedValueName,+    bindingVersion :: !BindingVersion,+    canonical :: !CanonicalTypeId,+    fixtures :: !QualifiedValueName,+    initial :: !(Maybe QualifiedValueName)+  }+  deriving stock (Eq, Ord, Show, Generic)++data NominalLeafKind+  = NominalIdLeaf !Text+  | NominalEnumLeaf !(NonEmpty (Name, Text))+  | NominalScalarLeaf !NominalScalarRepresentation+  deriving stock (Eq, Ord, Show, Generic)++data NominalLeafOwnership+  = GeneratedLeaf+  | ConsumerLeaf !ConsumerNominalBinding+  deriving stock (Eq, Ord, Show, Generic)++data NominalLeaf = NominalLeaf+  { name :: !Name,+    kind :: !NominalLeafKind,+    ownership :: !NominalLeafOwnership,+    loc :: !Loc+  }+  deriving stock (Eq, Show, Generic)++data NominalLeafIssue+  = LeafMissingIngredient !Name !Loc !Text+  | LeafInvalidHaskellSource !Name !Loc !Text+  | LeafInvalidQualifiedValue !Name !Loc !Text !Text+  | LeafInvalidIdentity !Name !Loc !Text !Text+  | LeafInvalidIdPrefix !Name !Loc !Text !Text+  | LeafEmptyEnum !Name !Loc+  | LeafUnsupportedScalar !Name !Loc !Name+  deriving stock (Eq, Show, Generic)++newtype NominalLeafError = NominalLeafError {nominalLeafIssues :: NonEmpty NominalLeafIssue}+  deriving stock (Eq, Show, Generic)++checkIdLeaf :: IdDecl -> Either NominalLeafError NominalLeaf+checkIdLeaf declaration = do+  ownership <- checkLeafOwnership ((.name) declaration) ((.loc) declaration) ((.binding) declaration)+  case (.binding) declaration >>= const (TypeID.checkPrefix ((.prefix) declaration)) of+    Just err ->+      Left+        ( NominalLeafError+            (LeafInvalidIdPrefix ((.name) declaration) ((.loc) declaration) ((.prefix) declaration) (T.pack (show err)) :| [])+        )+    Nothing ->+      Right+        NominalLeaf+          { name = (.name) declaration,+            kind = NominalIdLeaf ((.prefix) declaration),+            ownership = ownership,+            loc = (.loc) declaration+          }++checkEnumLeaf :: EnumDecl -> Either NominalLeafError NominalLeaf+checkEnumLeaf declaration = do+  ownership <- checkLeafOwnership ((.name) declaration) ((.loc) declaration) ((.binding) declaration)+  constructors <- case NE.nonEmpty ((.ctors) declaration) of+    Nothing -> Left (NominalLeafError (LeafEmptyEnum ((.name) declaration) ((.loc) declaration) :| []))+    Just values -> Right values+  Right+    NominalLeaf+      { name = (.name) declaration,+        kind = NominalEnumLeaf constructors,+        ownership = ownership,+        loc = (.loc) declaration+      }++checkScalarLeaf :: NominalScalarDecl -> Either NominalLeafError NominalLeaf+checkScalarLeaf declaration = do+  ownership <- checkRequiredLeafOwnership ((.name) declaration) ((.loc) declaration) ((.binding) declaration)+  representation <- case scalarLeafRepresentation ((.representation) declaration) of+    Nothing -> Left (NominalLeafError (LeafUnsupportedScalar ((.name) declaration) ((.loc) declaration) ((.representation) declaration) :| []))+    Just value -> Right value+  Right+    NominalLeaf+      { name = (.name) declaration,+        kind = NominalScalarLeaf representation,+        ownership = ownership,+        loc = (.loc) declaration+      }++checkLeafOwnership :: Name -> Loc -> Maybe NominalBindingDecl -> Either NominalLeafError NominalLeafOwnership+checkLeafOwnership _ _ Nothing = Right GeneratedLeaf+checkLeafOwnership name loc (Just declaration) = checkRequiredLeafOwnership name loc declaration++checkRequiredLeafOwnership :: Name -> Loc -> NominalBindingDecl -> Either NominalLeafError NominalLeafOwnership+checkRequiredLeafOwnership name loc declaration =+  case NE.nonEmpty issues of+    Just errors -> Left (NominalLeafError errors)+    Nothing -> case checkedBinding of+      Just value -> Right (ConsumerLeaf value)+      Nothing -> error "keiro-dsl internal invariant: a nominal leaf binding without issues is complete"+  where+    issues =+      [LeafMissingIngredient name loc label | (label, missing) <- missingFacts, missing]+        <> maybe [] (validateLeafHaskellSource name loc) ((.haskell) declaration)+        <> qualifiedIssues "binding" ((.binding) declaration)+        <> qualifiedIssues "fixtures" ((.fixtures) declaration)+        <> qualifiedIssues "initial" ((.initial) declaration)+        <> identityIssues "binding-version" ((.bindingVersion) declaration)+        <> canonicalIssues ((.canonicalType) declaration)+    missingFacts =+      [ ("haskell", (.haskell) declaration == Nothing),+        ("binding", (.binding) declaration == Nothing),+        ("binding-version", (.bindingVersion) declaration == Nothing),+        ("canonical-type", (.canonicalType) declaration == Nothing),+        ("fixtures", (.fixtures) declaration == Nothing)+      ]+    qualifiedIssues category value = case value of+      Just symbol | not (qualifiedValueSafe symbol) -> [LeafInvalidQualifiedValue name loc category symbol]+      _ -> []+    identityIssues category value = case value of+      Just identity | not (identitySafe identity) -> [LeafInvalidIdentity name loc category identity]+      _ -> []+    canonicalIssues value = case value of+      Just identity | not (identitySafe identity) -> [LeafInvalidIdentity name loc "canonical-type" identity]+      _ -> []+    checkedBinding =+      ConsumerNominalBinding+        <$> (.haskell) declaration+        <*> ((.binding) declaration >>= either (const Nothing) Just . mkQualifiedValueName)+        <*> ((.bindingVersion) declaration >>= either (const Nothing) Just . mkBindingVersion)+        <*> ((.canonicalType) declaration >>= either (const Nothing) Just . mkCanonicalTypeId)+        <*> ((.fixtures) declaration >>= either (const Nothing) Just . mkQualifiedValueName)+        <*> pure ((.initial) declaration >>= either (const Nothing) Just . mkQualifiedValueName)++validateLeafHaskellSource :: Name -> Loc -> HaskellSource -> [NominalLeafIssue]+validateLeafHaskellSource name loc source =+  [LeafInvalidHaskellSource name loc "package" | not (cabalPackageName ((.package) source))]+    <> [LeafInvalidHaskellSource name loc "module" | not (moduleNameSafe ((.moduleName) source))]+    <> [LeafInvalidHaskellSource name loc "type" | not (constructorSafe ((.valueType) source))]++scalarLeafRepresentation :: Name -> Maybe NominalScalarRepresentation+scalarLeafRepresentation = \case+  "Text" -> Just NominalText+  "Int" -> Just NominalInt+  "Natural" -> Just NominalNatural+  "Bool" -> Just NominalBool+  "Time" -> Just NominalTime+  "UTCTime" -> Just NominalTime+  _ -> Nothing+ data StructuralDecl = StructuralDecl   { name :: !Name,     haskell :: !HaskellSource,@@ -236,7 +408,9 @@   | ROptional !ResolvedTypeExpr   | RList !ResolvedTypeExpr   | RMap !ResolvedTypeExpr+  | RKeyedMap !NominalLeaf !ResolvedTypeExpr   | RRef !MappedKey+  | RNominal !NominalLeaf   deriving stock (Eq, Show, Generic)  data ResolvedWireField = ResolvedWireField@@ -273,29 +447,46 @@   | TGAmbiguousName !Name ![Text]   | TGUnresolvedRef !Name !Name !Loc   | TGUnresolvedConsumerRef !Text !Name !Loc+  | TGUnsupportedNominalLeaf !Name !Name !Text !Loc   | TGRecursive ![Name]   deriving stock (Eq, Show, Generic) -data UseSite-  = RootCommandField !Name !Name !Name !MappedKey-  | RootEventField !Name !Name !Name !MappedKey-  | RootRegister !Name !Name !MappedKey-  | RootWorkqueueField !Name !Name !MappedKey-  | RootReadModelQueryInput !Name !MappedKey-  | RootReadModelQueryResult !Name !MappedKey+data RootRef+  = RootCommandField !Name !Name !Name+  | RootEventField !Name !Name !Name+  | RootRegister !Name !Name+  | RootWorkqueueField !Name !Name+  | RootReadModelQueryInput !Name+  | RootReadModelQueryResult !Name+  | RootContractField !Name !Name !Name   deriving stock (Eq, Ord, Show, Generic) +data UseSite = UseSite+  { root :: !RootRef,+    mappedKey :: !MappedKey+  }+  deriving stock (Eq, Ord, Show, Generic)++data NominalRootSite = NominalRootSite+  { root :: !RootRef,+    nominal :: !Name,+    segments :: ![PathSeg]+  }+  deriving stock (Eq, Ord, Show, Generic)+ data PathSeg   = SegField !Name !Text   | SegArm !Name !Text   | SegElem+  | SegMapKey   | SegMapValue   | SegOptional   | SegDecl !Name+  | SegNominal !Name   deriving stock (Eq, Ord, Show, Generic)  data UsePath = UsePath-  { root :: !UseSite,+  { root :: !RootRef,     segments :: ![PathSeg]   }   deriving stock (Eq, Ord, Show, Generic)@@ -318,7 +509,11 @@ data TypeGraph = TypeGraph   { declarations :: !(Map MappedKey ResolvedMappedDecl),     reachability :: !(Map MappedKey (Set MappedKey)),+    nominalLeaves :: !(Map Name NominalLeaf),+    unsupportedNominalLeafKinds :: !(Map Name Text),+    nominalReachability :: !(Map MappedKey (Set Name)),     useSites :: ![UseSite],+    nominalRootSites :: ![NominalRootSite],     rootSegments :: !(Map UseSite [PathSeg]),     derivedMappedConsumers :: ![DerivedMappedConsumer],     replayableProjectionGroups :: !(Map DerivedMappedConsumer Name),@@ -332,25 +527,42 @@   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)+      nominalLeaves = collectNominalLeaves spec+      enumNames = Set.empty+      (resolveErrors, resolvedPairs) = partitionEithers (map (resolveCheckedDecl keyByName nominalLeaves enumNames) checked)   rejectMany resolveErrors   let declarations = Map.fromList resolvedPairs   rejectMany (cycleErrors declarations)   let reachability = Map.mapWithKey (reachableFrom declarations) declarations-      (rootErrors, rootSites) = partitionEithers (collectUseSites keyByName spec)+      nominalReachability = Map.mapWithKey (nominalsReachableFrom declarations) declarations+      (rootErrors, rootSites) = partitionEithers (collectUseSites keyByName nominalLeaves enumNames spec)   rejectMany rootErrors+  let mappedRootSites = [(site, segments) | CollectedMapped site segments <- rootSites]+      nominalRootSites = [site | CollectedNominal site <- rootSites]   pure     TypeGraph       { declarations = declarations,         reachability = reachability,-        useSites = map fst (catMaybes rootSites),-        rootSegments = Map.fromList (catMaybes rootSites),+        nominalLeaves = nominalLeaves,+        unsupportedNominalLeafKinds = Map.empty,+        nominalReachability = nominalReachability,+        useSites = map fst mappedRootSites,+        nominalRootSites = nominalRootSites,+        rootSegments = Map.fromList mappedRootSites,         derivedMappedConsumers = sort (derivedMappedConsumers spec),         replayableProjectionGroups = replayableProjectionGroups spec,         projectionOperationalIdentities = projectionOperationalIdentities spec,         unsupportedProjectionSources = sort (unsupportedProjectionSources spec)       } +collectNominalLeaves :: Spec -> Map Name NominalLeaf+collectNominalLeaves spec =+  Map.fromList+    [ ((.name) leaf, leaf)+    | result <- map checkIdLeaf ((.ids) spec) <> map checkEnumLeaf ((.enums) spec) <> map checkScalarLeaf ((.nominalScalars) spec),+      Right leaf <- [result]+    ]+ derivedMappedConsumers :: Spec -> [DerivedMappedConsumer] derivedMappedConsumers spec =   [ AggregateInlineProjectionConsumer ((.name) aggregate) ((.table) projection)@@ -445,7 +657,8 @@ ambiguityErrors spec declarations =   [ TGAmbiguousName name origins   | (name, origins) <- Map.toList allOrigins,-    length origins > 1+    length origins > 1,+    "mapped" `elem` origins || "built-in" `elem` origins   ]   where     builtins = ["Text", "Int", "Bool", "Natural", "Time", "UTCTime", "Json", "Optional", "List", "Map"]@@ -453,58 +666,75 @@       [(checkedName declaration, "mapped") | declaration <- declarations]         ++ [((.name) declaration, "id") | declaration <- (.ids) spec]         ++ [((.name) declaration, "enum") | declaration <- (.enums) spec]+        ++ [((.name) declaration, "nominal scalar") | declaration <- (.nominalScalars) 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) =+resolveCheckedDecl :: Map Name MappedKey -> Map Name NominalLeaf -> Set Name -> CheckedMappedDecl -> Either TypeGraphError (MappedKey, ResolvedMappedDecl)+resolveCheckedDecl _ _ _ (CheckedOpaque declaration) =   Right (MappedKey ((.name) declaration), ResolvedOpaque declaration)-resolveCheckedDecl keyByName (CheckedStructural declaration shape) = do-  resolvedShape <- resolveShape keyByName ((.name) declaration) shape+resolveCheckedDecl keyByName nominalByName enumNames (CheckedStructural declaration shape) = do+  resolvedShape <- resolveShape keyByName nominalByName enumNames ((.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) =+resolveShape :: Map Name MappedKey -> Map Name NominalLeaf -> Set Name -> Name -> MappedShape -> Either TypeGraphError ResolvedMappedShape+resolveShape keyByName nominalByName enumNames owner (ShapeRecord constructor unknownFields fields) =   RRecord constructor unknownFields <$> traverse resolveField fields   where     resolveField field =       ResolvedWireField         ((.haskell) field)         ((.key) field)-        <$> resolveExpr keyByName owner (wireFieldLoc field) ((.valueType) field)+        <$> resolveExpr keyByName nominalByName enumNames 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) =+resolveShape _ _ _ _ (ShapeEnum entries) = Right (REnum entries)+resolveShape keyByName nominalByName enumNames owner (ShapeUnion encoding arms) =   RUnion encoding <$> traverse resolveArm arms   where     resolveArm arm =       ResolvedWireArm         ((.ctor) arm)         ((.tag) arm)-        <$> traverse (resolveExpr keyByName owner ((.loc) arm)) ((.payload) arm)+        <$> traverse (resolveExpr keyByName nominalByName enumNames owner ((.loc) arm)) ((.payload) arm)         <*> pure ((.loc) arm) -resolveExpr :: Map Name MappedKey -> Name -> Loc -> TypeExpr -> Either TypeGraphError ResolvedTypeExpr-resolveExpr _ _ _ TText = Right RText-resolveExpr _ _ _ TInt = Right RInt-resolveExpr _ _ _ TInteger = Right RInteger-resolveExpr _ _ _ TBool = Right RBool-resolveExpr _ _ _ TNatural = Right RNatural-resolveExpr _ _ _ TTime = Right RTime-resolveExpr _ _ _ TJson = Right RJson-resolveExpr names owner loc (TOptional value) = ROptional <$> resolveExpr names owner loc value-resolveExpr names owner loc (TList value) = RList <$> resolveExpr names owner loc value-resolveExpr names owner loc (TMap value) = RMap <$> resolveExpr names owner loc value-resolveExpr names owner loc (TRef name) =-  maybe (Left (TGUnresolvedRef owner name loc)) (Right . RRef) (Map.lookup name names)+resolveExpr :: Map Name MappedKey -> Map Name NominalLeaf -> Set Name -> Name -> Loc -> TypeExpr -> Either TypeGraphError ResolvedTypeExpr+resolveExpr _ _ _ _ _ TText = Right RText+resolveExpr _ _ _ _ _ TInt = Right RInt+resolveExpr _ _ _ _ _ TInteger = Right RInteger+resolveExpr _ _ _ _ _ TBool = Right RBool+resolveExpr _ _ _ _ _ TNatural = Right RNatural+resolveExpr _ _ _ _ _ TTime = Right RTime+resolveExpr _ _ _ _ _ TJson = Right RJson+resolveExpr names nominals enums owner loc (TOptional value) = ROptional <$> resolveExpr names nominals enums owner loc value+resolveExpr names nominals enums owner loc (TList value) = RList <$> resolveExpr names nominals enums owner loc value+resolveExpr names nominals enums owner loc (TMap value) = RMap <$> resolveExpr names nominals enums owner loc value+resolveExpr names nominals enums owner loc (TKeyedMap key value) = do+  leaf <- case Map.lookup key nominals of+    Just candidate@NominalLeaf {kind = NominalIdLeaf {}} -> Right candidate+    Just NominalLeaf {kind = NominalEnumLeaf {}} -> Left (TGUnsupportedNominalLeaf owner key "enum map key" loc)+    Just NominalLeaf {kind = NominalScalarLeaf {}} -> Left (TGUnsupportedNominalLeaf owner key "nominal scalar map key" loc)+    Nothing+      | Map.member key names -> Left (TGUnsupportedNominalLeaf owner key "mapped map key" loc)+      | key `Set.member` enums -> Left (TGUnsupportedNominalLeaf owner key "enum map key" loc)+      | otherwise -> Left (TGUnresolvedRef owner key loc)+  RKeyedMap leaf <$> resolveExpr names nominals enums owner loc value+resolveExpr names nominals enums owner loc (TRef name) =+  case Map.lookup name names of+    Just key -> Right (RRef key)+    Nothing -> case Map.lookup name nominals of+      Just leaf -> Right (RNominal leaf)+      Nothing+        | name `Set.member` enums -> Left (TGUnsupportedNominalLeaf owner name "enum" loc)+        | otherwise -> Left (TGUnresolvedRef owner name loc)  -- | Resolve a consumer-surface type expression against an already checked -- graph. Emitters use this entry point instead of reconstructing declaration -- lookup rules independently. resolveTypeExpression :: TypeGraph -> Text -> Loc -> TypeExpr -> Either TypeGraphError ResolvedTypeExpr-resolveTypeExpression graph owner loc = resolveExpr keyByName owner loc+resolveTypeExpression graph owner loc = resolveExpr keyByName ((.nominalLeaves) graph) (Map.keysSet ((.unsupportedNominalLeafKinds) graph)) owner loc   where     keyByName = Map.fromList [(unMappedKey key, key) | key <- Map.keys ((.declarations) graph)] @@ -550,9 +780,55 @@         onOptional = id,         onList = id,         onMap = id,-        onRef = Set.singleton+        onKeyedMap = \_ -> id,+        onRef = Set.singleton,+        onNominal = const Set.empty       } +nominalRefsInExpr :: ResolvedTypeExpr -> Set Name+nominalRefsInExpr =+  foldTypeExpr+    TypeExprAlgebra+      { onText = Set.empty,+        onInt = Set.empty,+        onInteger = Set.empty,+        onBool = Set.empty,+        onNatural = Set.empty,+        onTime = Set.empty,+        onJson = Set.empty,+        onOptional = id,+        onList = id,+        onMap = id,+        onKeyedMap = \leaf value -> Set.insert ((.name) leaf) value,+        onRef = const Set.empty,+        onNominal = Set.singleton . (.name)+      }++directNominalRefs :: ResolvedMappedDecl -> Set Name+directNominalRefs =+  foldMappedDecl+    MappedDeclAlgebra+      { onStructuralDecl = \_ shape ->+          foldMappedShape+            MappedShapeAlgebra+              { onRecord = \_ _ fields -> Set.unions (map (nominalRefsInExpr . (.valueType)) fields),+                onEnum = const Set.empty,+                onUnion = \_ arms -> Set.unions (map (maybe Set.empty nominalRefsInExpr . (.payload)) arms)+              }+            shape,+        onOpaqueDecl = const Set.empty+      }++nominalsReachableFrom :: Map MappedKey ResolvedMappedDecl -> MappedKey -> ResolvedMappedDecl -> Set Name+nominalsReachableFrom declarations _ declaration = go Set.empty Set.empty [declaration]+  where+    go _ names [] = names+    go visited names (current : rest) =+      let names' = names <> directNominalRefs current+          nextKeys = Set.toList (directRefs current `Set.difference` visited)+          next = [value | key <- nextKeys, Just value <- [Map.lookup key declarations]]+       in go (visited <> Set.fromList nextKeys) names' (next <> rest)+ reachableFrom :: Map MappedKey ResolvedMappedDecl -> MappedKey -> ResolvedMappedDecl -> Set MappedKey reachableFrom declarations origin declaration = go Set.empty (Set.toList (directRefs declaration))   where@@ -563,31 +839,74 @@           let next = maybe [] (Set.toList . directRefs) (Map.lookup key declarations)            in go (Set.insert key visited) (next ++ rest) -collectUseSites :: Map Name MappedKey -> Spec -> [Either TypeGraphError (Maybe (UseSite, [PathSeg]))]-collectUseSites keyByName spec =-  map (Right . Just) (concatMap aggregateSites aggregates)+data CollectedRoot+  = CollectedMapped !UseSite ![PathSeg]+  | CollectedNominal !NominalRootSite+  | CollectedNone++data RootReference+  = MappedRootReference !MappedKey ![PathSeg]+  | NominalRootReference !Name ![PathSeg]++collectUseSites :: Map Name MappedKey -> Map Name NominalLeaf -> Set Name -> Spec -> [Either TypeGraphError CollectedRoot]+collectUseSites keyByName nominalByName enumNames spec =+  map Right (concatMap aggregateSites aggregates)+    <> map Right (concatMap contractSites contracts)     <> concatMap workqueueSites workqueues     <> concatMap readModelSites readModels   where     aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]+    contracts = [contract | NContract contract <- (.nodes) spec]     workqueues = [workqueue | NWorkqueue workqueue <- (.nodes) spec]     readModels = [readModel | NReadModel readModel <- (.nodes) spec]     aggregateSites aggregate =-      [ (RootCommandField ((.name) aggregate) ((.name) command) ((.name) field) key, [])+      [ aggregateSite+          (RootCommandField ((.name) aggregate) ((.name) command) ((.name) field))+          ((.loc) field)+          expression       | command <- (.commands) aggregate,         field <- (.fields) command,-        key <- maybeToList ((.valueType) field >>= typeRefName >>= (`Map.lookup` keyByName))+        expression <- maybeToList ((.valueType) field)       ]-        ++ [ (RootEventField ((.name) aggregate) ((.name) event) ((.name) field) key, [])+        ++ [ aggregateSite+               (RootEventField ((.name) aggregate) ((.name) event) ((.name) field))+               ((.loc) field)+               expression            | event <- (.events) aggregate,              field <- eventFields aggregate event,-             key <- maybeToList ((.valueType) field >>= typeRefName >>= (`Map.lookup` keyByName))+             expression <- maybeToList ((.valueType) field)            ]-        ++ [ (RootRegister ((.name) aggregate) ((.name) register) key, [])-           | register <- (.regs) aggregate,-             key <- maybeToList (typeRefName ((.valueType) register) >>= (`Map.lookup` keyByName))+        ++ [ aggregateSite+               (RootRegister ((.name) aggregate) ((.name) register))+               ((.loc) register)+               ((.valueType) register)+           | register <- (.regs) aggregate            ] +    contractSites contract =+      [ CollectedNominal+          ( NominalRootSite+              (RootContractField ((.name) contract) ((.name) event) ((.name) field))+              nominalName+              []+          )+      | event <- (.events) contract,+        field <- (.fields) event,+        CDeclaredId nominalName <- [(.valueType) field],+        Just NominalLeaf {kind = NominalIdLeaf {}} <- [Map.lookup nominalName nominalByName]+      ]++    -- Aggregate validation owns unresolved and enum references.  This graph+    -- projection records only the mapped/nominal roots it can resolve without+    -- changing those established diagnostics.+    aggregateSite rootRef loc expression =+      case resolveExpr keyByName nominalByName enumNames "aggregate consumer" loc expression of+        Right resolved -> case rootReference resolved of+          Just (MappedRootReference key segments) -> CollectedMapped (UseSite rootRef key) segments+          Just (NominalRootReference name segments) -> CollectedNominal (NominalRootSite rootRef name segments)+          Nothing -> CollectedNone+        Left _ -> CollectedNone+     workqueueSites workqueue =       [ consumerSite           ("workqueue '" <> (.name) workqueue <> "' payload field '" <> (.name) field <> "'")@@ -613,13 +932,14 @@             result         ] -    consumerSite owner loc constructor expression =-      case resolveExpr keyByName owner loc expression of+    consumerSite owner loc rootRef expression =+      case resolveExpr keyByName nominalByName enumNames owner loc expression of         Left (TGUnresolvedRef _ missing _) -> Left (TGUnresolvedConsumerRef owner missing loc)         Left other -> Left other         Right resolved -> case rootReference resolved of-          Nothing -> Right Nothing-          Just (key, segments) -> Right (Just (constructor key, segments))+          Nothing -> Right CollectedNone+          Just (MappedRootReference key segments) -> Right (CollectedMapped (UseSite rootRef key) segments)+          Just (NominalRootReference name segments) -> Right (CollectedNominal (NominalRootSite rootRef name segments))      rootReference = \case       RText -> Nothing@@ -632,8 +952,12 @@       ROptional value -> prepend SegOptional (rootReference value)       RList value -> prepend SegElem (rootReference value)       RMap value -> prepend SegMapValue (rootReference value)-      RRef key -> Just (key, [])-    prepend segment = fmap (\(key, segments) -> (key, segment : segments))+      RKeyedMap _ value -> prepend SegMapValue (rootReference value)+      RRef key -> Just (MappedRootReference key [])+      RNominal leaf -> Just (NominalRootReference ((.name) leaf) [])+    prepend segment = fmap $ \case+      MappedRootReference key segments -> MappedRootReference key (segment : segments)+      NominalRootReference name segments -> NominalRootReference name (segment : segments)      eventFields aggregate event = case (.body) event of       EventFields fields -> fields@@ -641,22 +965,23 @@         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) ((.declarations) graph) of   Nothing -> []   Just _ ->-    [ UsePath site segments+    [ UsePath ((.root) site) segments     | site <- (.useSites) graph,       segments <- sitePaths site     ]   where     target = MappedKey targetName     sitePaths site-      | siteKey site == target = [rootSegments site]-      | otherwise = map (rootSegments site <>) (pathsFromDecl Set.empty (siteKey site))+      | siteKey site == target = [[SegDecl (unMappedKey target)] <> rootSegments site]+      | otherwise =+          map+            (\segments -> [SegDecl (unMappedKey (siteKey site))] <> rootSegments site <> segments)+            (pathsFromDecl Set.empty (siteKey site))      rootSegments = useSiteSegments graph @@ -699,17 +1024,84 @@       ROptional value -> map (SegOptional :) (pathsInExpr visited value)       RList value -> map (SegElem :) (pathsInExpr visited value)       RMap value -> map (SegMapValue :) (pathsInExpr visited value)+      RKeyedMap _ value -> map (SegMapValue :) (pathsInExpr visited value)       RRef key         | key == target -> [[SegDecl (unMappedKey key)]]         | otherwise -> map (SegDecl (unMappedKey key) :) (pathsFromDecl visited key)+      RNominal _ -> [] +nominalUsePaths :: TypeGraph -> Name -> [UsePath]+nominalUsePaths graph targetName+  | Map.notMember targetName ((.nominalLeaves) graph) = []+  | otherwise = mappedPaths <> directPaths+  where+    mappedPaths =+      [ UsePath+          ((.root) site)+          ( [SegDecl (unMappedKey (siteKey site))]+              <> useSiteSegments graph site+              <> segments+          )+      | site <- (.useSites) graph,+        segments <- pathsFromDecl Set.empty (siteKey site)+      ]+    directPaths =+      [ UsePath ((.root) site) ([SegNominal targetName] <> (.segments) site)+      | site <- (.nominalRootSites) graph,+        (.nominal) site == targetName+      ]++    pathsFromDecl visited current+      | current `Set.member` visited = []+      | otherwise = case Map.lookup current ((.declarations) graph) of+          Nothing -> []+          Just declaration ->+            foldMappedDecl+              MappedDeclAlgebra+                { onStructuralDecl = \_ shape -> pathsInShape (Set.insert current visited) shape,+                  onOpaqueDecl = const []+                }+              declaration++    pathsInShape visited =+      foldMappedShape+        MappedShapeAlgebra+          { onRecord = \_ _ fields ->+              concat+                [ map (SegField ((.haskell) field) ((.key) field) :) (pathsInExpr visited ((.valueType) field))+                | field <- fields+                ],+            onEnum = const [],+            onUnion = \_ arms ->+              concat+                [ map (SegArm ((.ctor) arm) ((.tag) arm) :) (maybe [] (pathsInExpr visited) ((.payload) arm))+                | arm <- arms+                ]+          }++    pathsInExpr visited = \case+      RText -> []+      RInt -> []+      RInteger -> []+      RBool -> []+      RNatural -> []+      RTime -> []+      RJson -> []+      ROptional value -> map (SegOptional :) (pathsInExpr visited value)+      RList value -> map (SegElem :) (pathsInExpr visited value)+      RMap value -> map (SegMapValue :) (pathsInExpr visited value)+      RKeyedMap leaf value ->+        [ [SegMapKey, SegNominal targetName]+        | (.name) leaf == targetName+        ]+          <> map (SegMapValue :) (pathsInExpr visited value)+      RRef key -> map (SegDecl (unMappedKey key) :) (pathsFromDecl visited key)+      RNominal leaf+        | (.name) leaf == targetName -> [[SegNominal targetName]]+        | otherwise -> []+ siteKey :: UseSite -> MappedKey-siteKey (RootCommandField _ _ _ key) = key-siteKey (RootEventField _ _ _ key) = key-siteKey (RootRegister _ _ key) = key-siteKey (RootWorkqueueField _ _ key) = key-siteKey (RootReadModelQueryInput _ key) = key-siteKey (RootReadModelQueryResult _ key) = key+siteKey = (.mappedKey)  -- | Container path segments attached to a consumer root before its first -- mapped declaration reference.@@ -719,27 +1111,31 @@ renderUsePath :: UsePath -> Text renderUsePath (UsePath root segments) = renderRoot root <> T.concat (map renderSegment segments)   where-    renderRoot (RootCommandField aggregate command field key) =-      aggregate <> " command " <> command <> " ." <> field <> " : " <> unMappedKey key-    renderRoot (RootEventField aggregate event field key) =-      aggregate <> " event " <> event <> " ." <> field <> " : " <> unMappedKey key-    renderRoot (RootRegister aggregate register key) =-      aggregate <> " register " <> register <> " : " <> unMappedKey key-    renderRoot (RootWorkqueueField workqueue field key) =-      "workqueue " <> workqueue <> " payload ." <> field <> " : " <> unMappedKey key-    renderRoot (RootReadModelQueryInput readModel key) =-      "readmodel " <> readModel <> " query input : " <> unMappedKey key-    renderRoot (RootReadModelQueryResult readModel key) =-      "readmodel " <> readModel <> " query result : " <> unMappedKey key+    renderRoot (RootCommandField aggregate command field) =+      aggregate <> " command " <> command <> " ." <> field+    renderRoot (RootEventField aggregate event field) =+      aggregate <> " event " <> event <> " ." <> field+    renderRoot (RootRegister aggregate register) =+      aggregate <> " register " <> register+    renderRoot (RootWorkqueueField workqueue field) =+      "workqueue " <> workqueue <> " payload ." <> field+    renderRoot (RootReadModelQueryInput readModel) =+      "readmodel " <> readModel <> " query input"+    renderRoot (RootReadModelQueryResult readModel) =+      "readmodel " <> readModel <> " query result"+    renderRoot (RootContractField contract event field) =+      "contract " <> contract <> " event " <> event <> " ." <> field      renderSegment (SegField haskellName wireName)       | haskellName == wireName = " ." <> haskellName       | otherwise = " ." <> haskellName <> " as " <> quoted wireName     renderSegment (SegArm _ wireTag) = " arm " <> quoted wireTag     renderSegment SegElem = " []"+    renderSegment SegMapKey = " {key}"     renderSegment SegMapValue = " {}"     renderSegment SegOptional = " optional"     renderSegment (SegDecl name) = " : " <> name+    renderSegment (SegNominal name) = " : " <> name     quoted value = T.pack (show value)  data TypeExprAlgebra a = TypeExprAlgebra@@ -753,7 +1149,9 @@     onOptional :: a -> a,     onList :: a -> a,     onMap :: a -> a,-    onRef :: MappedKey -> a+    onKeyedMap :: NominalLeaf -> a -> a,+    onRef :: MappedKey -> a,+    onNominal :: NominalLeaf -> a   }  foldTypeExpr :: TypeExprAlgebra a -> ResolvedTypeExpr -> a@@ -768,7 +1166,9 @@   ROptional value -> (.onOptional) algebra (foldTypeExpr algebra value)   RList value -> (.onList) algebra (foldTypeExpr algebra value)   RMap value -> (.onMap) algebra (foldTypeExpr algebra value)+  RKeyedMap key value -> (.onKeyedMap) algebra key (foldTypeExpr algebra value)   RRef key -> (.onRef) algebra key+  RNominal leaf -> (.onNominal) algebra leaf  data MappedShapeAlgebra a = MappedShapeAlgebra   { onRecord :: Name -> UnknownFields -> [ResolvedWireField] -> a,@@ -800,7 +1200,7 @@     wireDecl visited key       | key `Set.member` visited = "recursive"       | otherwise = case Map.lookup key declarations of-          Nothing -> "missing:" <> unMappedKey key+          Nothing -> error ("keiro-dsl internal invariant: wire fingerprint references missing mapped declaration " <> T.unpack (unMappedKey key))           Just declaration ->             foldMappedDecl               MappedDeclAlgebra@@ -851,7 +1251,9 @@       ROptional value -> "optional(" <> wireExpr visited value <> ")"       RList value -> "list(" <> wireExpr visited value <> ")"       RMap value -> "map(" <> wireExpr visited value <> ")"+      RKeyedMap key value -> "map(key=" <> nominalWireToken key <> ";" <> wireExpr visited value <> ")"       RRef key -> wireDecl visited key+      RNominal leaf -> nominalWireToken leaf      renderDefault field (OmCtor constructor) =       case (.valueType) field of@@ -859,6 +1261,11 @@           Just (ResolvedStructural _ (REnum entries)) ->             maybe ("ctor:" <> atom constructor) ("enum:" <>) (lookup constructor [((.ctor) entry, atom ((.tag) entry)) | entry <- entries])           _ -> "ctor:" <> atom constructor+        RNominal leaf -> case (.kind) leaf of+          NominalEnumLeaf constructors ->+            maybe ("ctor:" <> atom constructor) ("enum:" <>) (lookup constructor [(constructorName, atom wire) | (constructorName, wire) <- NE.toList constructors])+          NominalIdLeaf {} -> "ctor:" <> atom constructor+          NominalScalarLeaf {} -> "ctor:" <> atom constructor         _ -> "ctor:" <> atom constructor     renderDefault _ value = T.pack (show value) @@ -868,6 +1275,29 @@     renderPresence POptional = "optional"     atom value = T.pack (show value) +nominalWireFingerprint :: NominalLeaf -> Text+nominalWireFingerprint = fnv1a64 . nominalWireToken++nominalWireToken :: NominalLeaf -> Text+nominalWireToken leaf = case (.kind) leaf of+  NominalIdLeaf prefix -> "nominal-id(" <> prefix <> "," <> nominalIdDomainVersion <> ")"+  NominalEnumLeaf constructors ->+    "nominal-enum(" <> T.intercalate ";" (sort (map snd (NE.toList constructors))) <> ")"+  NominalScalarLeaf representation -> "nominal-scalar(" <> scalarToken representation <> ")"+  where+    scalarToken = \case+      NominalText -> "Text"+      NominalInt -> "Int"+      NominalNatural -> "Natural"+      NominalBool -> "Bool"+      NominalTime -> "Time"++-- Kept byte-identical to Keiro.Dsl.IdDomain.enforcedIdDomainVersion.  This+-- low-level graph module cannot import IdDomain because that module reads+-- CheckedService, whose analysis contains this graph.+nominalIdDomainVersion :: Text+nominalIdDomainVersion = "keiro-dsl/id-domain/typeid-v7/1"+ fnv1a64 :: Text -> Text fnv1a64 input =   let offsetBasis = 14695981039346656037 :: Word64@@ -875,3 +1305,40 @@       digest = T.foldl' (\hash char -> (hash `xor` fromIntegral (ord char)) * prime) offsetBasis input       hexadecimal = showHex digest ""    in T.pack (replicate (16 - length hexadecimal) '0' <> hexadecimal)++cabalPackageName :: Text -> Bool+cabalPackageName packageName = not (null components) && all validComponent components+  where+    components = T.splitOn "-" packageName+    validComponent component = not (T.null component) && T.all asciiAlphaNum component && T.any asciiLetter component++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++constructorSafe :: Text -> Bool+constructorSafe name = case T.uncons name of+  Just (initial, rest) -> asciiUpper initial && T.all asciiAlphaNumOrUnderscore rest+  Nothing -> False++lowerIdentifierSafe :: Text -> Bool+lowerIdentifierSafe name = case T.uncons name of+  Just (initial, rest) -> asciiLower initial && T.all asciiAlphaNumOrUnderscore rest && name `Set.notMember` haskellKeywords+  Nothing -> False++identitySafe :: Text -> Bool+identitySafe value = not (T.null (T.strip value)) && not (T.any asciiControl value)++asciiUpper, asciiLower, asciiLetter, asciiAlphaNum, asciiAlphaNumOrUnderscore, asciiControl :: Char -> Bool+asciiUpper c = isAscii c && isUpper c+asciiLower c = isAscii c && isLower c+asciiLetter c = asciiUpper c || asciiLower c+asciiAlphaNum c = asciiLetter c || (isAscii c && isDigit c)+asciiAlphaNumOrUnderscore c = asciiAlphaNum c || c == '_'+asciiControl c = ord c < 32 || ord c == 127
src/Keiro/Dsl/Validate.hs view
@@ -50,6 +50,7 @@ import Keiro.Dsl.IdDomain (contractIdDomainContractFor, idDomainContractFor) import Keiro.Dsl.LanguageVersion (LanguageVersion, RuntimeCapability (..), SourceLanguage (..), effectiveLanguageVersion, languageVersionText, runtimeProfileHasCapability, sourceFormText) import Keiro.Dsl.NominalType qualified as Nominal+import Keiro.Dsl.ProcessReaction qualified as ProcessReaction import Keiro.Dsl.ProjectionSupply import Keiro.Dsl.ReadModelShape (deriveShapeHash) import Keiro.Dsl.RouterSelection qualified as RouterSelection@@ -99,11 +100,31 @@   | ProcessUnresolvedRef   | ProcessBenignInversion   | SagaCategoryIllegal+  | ProcessReactionUnknownInput+  | ProcessInputDuplicateDeclaration+  | ProcessTimerDuplicateName+  | ProcessReactionGuardNotBoolean+  | ProcessStateAccessUnsupported+  | ProcessReactionInputUnhandled+  | ProcessReactionDuplicateInput+  | ProcessReactionOtherwiseMissing+  | ProcessReactionOtherwiseUnreachable+  | ProcessTimerPrefixCollision+  | ProcessScheduleUnknownTimer+  | ProcessCancelUnknownTimer+  | ProcessSchedulePayloadIncomplete+  | ProcessTimerPolicyMissing+  | ProcessTimerPolicyUnused+  | ProcessAcceptedArmRequiresEvent+  | ProcessSilentArmMissing+  | ProcessAcceptedArmUnverified+  | ProcessBindingTypeMismatch   | -- EP-4 (integration intake / inbox disposition).     DispositionIncomplete   | DispositionDuplicateRetry   | DispositionPreviouslyFailedRetry   | DispositionDecodeUnboundedRetry+  | DelegatedInboxDedupeOnlyPersistence   | -- EP-4 (integration coupling).     EmitSkipMissing   | EmitUnresolvedContract@@ -158,6 +179,7 @@   | EmitMappingChanged   | DecodePostureChanged   | IntakePersistenceChanged+  | IntakeIdempotenceModeChanged   | ProjectionChanged   | PublisherPolicyChanged   | DispatchRetargeted@@ -312,6 +334,19 @@   | RouterDecideSurfaceChanged   | ProcessDecideSurfaceChanged   | ProcessTimerPayloadChanged+  | ProcessReactionAdded+  | ProcessReactionRemoved+  | ProcessReactionFanOutChanged+  | ProcessReactionGuardChanged+  | ProcessReactionArmsReordered+  | ProcessTimerAdded+  | ProcessTimerRemoved+  | ProcessTimerIdentityChanged+  | ProcessTimerCeilingChanged+  | ProcessReactionVersionDecreased+  | ProcessReactionFingerprintChangedWithoutVersionBump+  | ProcessReactionFingerprintChangedWithVersionBump+  | ProcessDispatchIdentityModelChanged   | -- MasterPlan 25 / EP-5: append-only codes for findings that were     -- formerly additive but uncoded.     DeclarationAdded@@ -324,6 +359,8 @@   | WorkflowEvolutionGuardAdded   | -- MasterPlan 25 / EP-149 (consumer-owned mapped types).     MappedUnresolvedName+  | MappedNominalLeafRequiresLanguage+  | MappedNominalLeafUnsupported   | MappedAmbiguousName   | MappedDuplicateFieldName   | MappedDuplicateWireKey@@ -449,6 +486,7 @@   | AggregateEventlessStateChange   | -- ExecPlan 178: language-4 integration contract TypeID admission.     ContractInvalidTypeIdPrefix+  | ContractIdUnknown   | ContractTypeIdDomainChanged   | -- ExecPlan 180: accepted-but-unenforced spec surfaces.     PublisherOrderingUnknown@@ -565,6 +603,10 @@   | RouterSelectionCommandMappingDuplicate   | RouterSelectionCommandMappingIncomplete   | RouterSelectionCommandMappingTypeMismatch+  | -- ExecPlan 265: exact family cancellation could not identify one guard pair.+    AggGuardRelationUnknown+  | -- ExecPlan 266: a computed replay-only remedy failed its source proof.+    AggGuardRemedyUnavailable   deriving stock (Eq, Ord, Show, Enum, Bounded)  -- | Which command pipeline can actually produce a given 'DiagnosticCode'.@@ -609,6 +651,8 @@   -- Cross-revision evolution facts.   AggFoldSurfaceChanged -> DiffDiagnostic   AggGuardTightened -> DiffDiagnostic+  AggGuardRelationUnknown -> DiffDiagnostic+  AggGuardRemedyUnavailable -> DiffDiagnostic   DomainOutcomeTypesChanged -> DiffDiagnostic   DomainTransitionOutcomeChanged -> DiffDiagnostic   CompatibilityStrengthened -> DiffDiagnostic@@ -642,6 +686,7 @@   IdDomainContractChanged -> DiffDiagnostic   IdPrefixChanged -> DiffDiagnostic   IntakePersistenceChanged -> DiffDiagnostic+  IntakeIdempotenceModeChanged -> DiffDiagnostic   MappedArmAdded -> DiffDiagnostic   MappedArmRemoved -> DiffDiagnostic   MappedArmTagChanged -> DiffDiagnostic@@ -677,7 +722,20 @@   OwnershipMoved -> DiffDiagnostic   ProcessDecideSurfaceChanged -> DiffDiagnostic   ProcessInputChanged -> DiffDiagnostic+  ProcessDispatchIdentityModelChanged -> DiffDiagnostic+  ProcessReactionAdded -> DiffDiagnostic+  ProcessReactionArmsReordered -> DiffDiagnostic+  ProcessReactionFanOutChanged -> DiffDiagnostic+  ProcessReactionFingerprintChangedWithVersionBump -> DiffDiagnostic+  ProcessReactionFingerprintChangedWithoutVersionBump -> DiffDiagnostic+  ProcessReactionGuardChanged -> DiffDiagnostic+  ProcessReactionRemoved -> DiffDiagnostic+  ProcessReactionVersionDecreased -> DiffDiagnostic+  ProcessTimerAdded -> DiffDiagnostic+  ProcessTimerCeilingChanged -> DiffDiagnostic+  ProcessTimerIdentityChanged -> DiffDiagnostic   ProcessTimerPayloadChanged -> DiffDiagnostic+  ProcessTimerRemoved -> DiffDiagnostic   ProjectionChanged -> DiffDiagnostic   PublisherPolicyChanged -> DiffDiagnostic   QueueIdentityChanged -> DiffDiagnostic@@ -791,7 +849,7 @@  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))+  sortOn (.line) (validateNames languageContract typeGraphResult spec ++ validateMapped languageContract 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@@ -869,14 +927,14 @@           EventFields fields -> concatMap (fieldRule aggregate EventFieldUse) fields           EventFromCommand _ -> []         registerRules register = case resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register) of-          Left typeError -> [aggregateTypeDiagnostic typeError]+          Left typeError -> [aggregateTypeDiagnostic spec typeError]           Right AggregateMapped {} -> []           Right resolved -> case resolveRegisterInitial symbols ((.loc) register) resolved ((.initial) register) of-            Left initialError -> [aggregateTypeDiagnostic initialError]+            Left initialError -> [aggregateTypeDiagnostic spec initialError]             Right _ -> []      fieldRule aggregate useSite field =-      either (pure . aggregateTypeDiagnostic) (const []) (inferAggregateFieldType symbols aggregate useSite field)+      either (pure . aggregateTypeDiagnostic spec) (const []) (inferAggregateFieldType symbols aggregate useSite field)      outcomeTypeRules aggregate = case (.domainOutcomeTypes) aggregate of       Nothing -> []@@ -928,7 +986,7 @@     outcomeExpressionDiagnostic label diagnostic =       mkErr         (locLine ((.loc) diagnostic))-        ( if (.code) diagnostic `elem` [ScalarOperandTypeMismatch, ScalarBooleanOperandRequired]+        ( if (.code) diagnostic `elem` [ScalarOperandTypeMismatch, ScalarNominalTypeMismatch, ScalarBooleanOperandRequired]             then DomainOutcomeReasonTypeMismatch             else expressionCode ((.code) diagnostic)         )@@ -950,7 +1008,9 @@       ScalarLiteralNeedsType -> AggregateExpressionLiteralNeedsType       ScalarLiteralInvalid -> AggregateExpressionLiteralInvalid       ScalarOperandTypeMismatch -> AggregateExpressionOperandTypeMismatch+      ScalarNominalTypeMismatch -> AggregateGuardTypeMismatch       ScalarOperatorUnsupported -> AggregateExpressionOperatorUnsupported+      ScalarNominalOperatorUnsupported -> AggregateGuardCapabilityUnsupported       ScalarBooleanOperandRequired -> AggregateExpressionBooleanRequired       ScalarGuardBoolRequired -> AggregateExpressionGuardBoolRequired       ScalarWriteTargetUnknown -> AggregateExpressionWriteTargetUnknown@@ -1037,8 +1097,8 @@       ELiteral {} -> []       EAtom {} -> [] -aggregateTypeDiagnostic :: AggregateTypeError -> Diagnostic-aggregateTypeDiagnostic aggregateError =+aggregateTypeDiagnostic :: Spec -> AggregateTypeError -> Diagnostic+aggregateTypeDiagnostic spec aggregateError =   mkErr (locLine ((.loc) aggregateError)) diagnosticCode diagnosticMessage   where     diagnosticCode = case (.reason) aggregateError of@@ -1057,7 +1117,7 @@           <> typeExprCanonicalName expression           <> "' is unsupported at "           <> renderAggregateUseSite ((.useSite) aggregateError)-          <> "; use a mapped structural declaration for Json or container shapes"+          <> unsupportedShapeGuidance expression       UnsupportedAggregateCapability resolved ->         renderAggregateUseSite ((.useSite) aggregateError)           <> " is unsupported for aggregate type '"@@ -1065,6 +1125,28 @@           <> "'"       InvalidRegisterInitial resolved detail ->         "invalid " <> aggregateCanonicalName resolved <> " register initial: " <> detail+    unsupportedShapeGuidance = \case+      TOptional (TRef name)+        | name `Set.member` nominalNames ->+            "; declare `mapped structural record "+              <> name+              <> "Ref { "+              <> lowerInitial name+              <> " as \""+              <> lowerInitial name+              <> "\" : Optional "+              <> name+              <> " optional on-missing=null }` and use it as the field type (candidate Language 6)"+      _ -> "; use a mapped structural declaration for Json or container shapes"+    nominalNames =+      Set.fromList+        ( map (.name) ((.ids) spec)+            <> map (.name) ((.enums) spec)+            <> map (.name) ((.nominalScalars) spec)+        )+    lowerInitial name = case T.uncons name of+      Nothing -> name+      Just (first, rest) -> T.cons (toLower first) rest  renderAggregateUseSite :: AggregateUseSite -> Text renderAggregateUseSite useSite = case useSite of@@ -1083,14 +1165,14 @@ -- 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 =+validateMapped :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [Diagnostic]+validateMapped languageContract typeGraphResult spec =   mappedLexicalRules spec     ++ mappedIdentityRules spec     ++ mappedConflictRules spec     ++ case typeGraphResult of       Left errors -> concatMap (typeGraphDiagnostic spec) (NE.toList errors)-      Right graph -> mappedGraphRules spec graph+      Right graph -> nominalLeafLanguageRules languageContract spec graph ++ mappedGraphRules spec graph  typeGraphDiagnostic :: Spec -> TypeGraphError -> [Diagnostic] typeGraphDiagnostic spec = \case@@ -1118,17 +1200,48 @@     ]   TGUnresolvedRef owner missing loc ->     [ mkErr (locLine loc) MappedUnresolvedName $-        "mapped declaration '" <> owner <> "' references unresolved mapped type '" <> missing <> "'"+        if declaredNominal spec missing+          then mappedOwnerAt spec owner loc <> " references malformed nominal declaration '" <> missing <> "'"+          else mappedOwnerAt spec owner loc <> " references unresolved mapped type '" <> missing <> "'"     ]   TGUnresolvedConsumerRef owner missing loc ->     [ mkErr (locLine loc) MappedUnresolvedName $-        owner <> " references unresolved mapped type '" <> missing <> "'"+        if declaredNominal spec missing+          then owner <> " references malformed nominal declaration '" <> missing <> "'"+          else owner <> " references unresolved mapped type '" <> missing <> "'"     ]+  TGUnsupportedNominalLeaf owner name category loc ->+    [ mkErr (locLine loc) MappedNominalLeafUnsupported $+        if " map key" `T.isSuffixOf` category+          then mappedOwnerAt spec owner loc <> " uses " <> T.dropEnd 8 category <> " '" <> name <> "' as a map key; map keys must be declared ids"+          else mappedOwnerAt spec owner loc <> " uses " <> category <> " '" <> name <> "'; nominal enums are not supported as structural leaves, declare a mapped structural enum instead"+    ]   TGRecursive names ->     [ mkErr (mappedLine spec (headOr "<mapped>" names)) MappedRecursiveType $         "recursive structural mapping is unsupported: " <> T.intercalate " -> " (names <> take 1 names)     ] +declaredNominal :: Spec -> Name -> Bool+declaredNominal spec name =+  any ((== name) . (.name)) ((.ids) spec)+    || any ((== name) . (.name)) ((.nominalScalars) spec)++mappedOwnerAt :: Spec -> Name -> Loc -> Text+mappedOwnerAt spec owner useLoc =+  case [shape | MappedStructural {msName, msShape = shape} <- (.mapped) spec, msName == owner] of+    ShapeRecord _ _ fields : _ ->+      case [(.haskell) field | field <- fields, (.loc) field == useLoc] of+        fieldName : _ -> "mapped declaration '" <> owner <> "' field '" <> fieldName <> "'"+        [] -> declaration+    ShapeUnion _ arms : _ ->+      case [(.ctor) arm | arm <- arms, (.loc) arm == useLoc] of+        armName : _ -> "mapped declaration '" <> owner <> "' union arm '" <> armName <> "'"+        [] -> declaration+    _ : _ -> declaration+    [] -> owner+  where+    declaration = "mapped declaration '" <> owner <> "'"+ declarationErrorMessage :: MappedDeclError -> Text declarationErrorMessage = \case   MissingHaskellSource _ -> "missing complete haskell package/module/type ingredient"@@ -1264,6 +1377,121 @@     conflict declaration detail = mkErr (locLine (mappedLoc declaration)) MappedImportConflict detail     maybeToList = maybe [] pure +nominalLeafLanguageRules :: EffectiveLanguageContract -> Spec -> TypeGraph -> [Diagnostic]+nominalLeafLanguageRules languageContract spec graph+  | runtimeProfileHasCapability ((.runtimeProfile) languageContract) StructuralNominalLeaves = []+  | otherwise =+      concatMap declarationRules (Map.elems ((.declarations) graph))+        <> concatMap rootRule [site | site <- (.nominalRootSites) graph, candidateOnlyRoot ((.root) site)]+  where+    declarationRules =+      foldMappedDecl+        MappedDeclAlgebra+          { onStructuralDecl = \declaration shape ->+              foldMappedShape+                MappedShapeAlgebra+                  { onRecord = \_ _ fields ->+                      [ languageError ((.loc) field) ("mapped declaration '" <> (.name) declaration <> "' field '" <> (.haskell) field <> "'") nominal+                      | field <- fields,+                        nominal <- Set.toAscList (nominalNamesInExpr ((.valueType) field))+                      ],+                    onEnum = const [],+                    onUnion = \_ arms ->+                      [ languageError ((.loc) arm) ("mapped declaration '" <> (.name) declaration <> "' arm '" <> (.ctor) arm <> "'") nominal+                      | arm <- arms,+                        payload <- maybeToList ((.payload) arm),+                        nominal <- Set.toAscList (nominalNamesInExpr payload)+                      ]+                  }+                shape,+            onOpaqueDecl = const []+          }+    rootRule site =+      [languageError (rootRefLoc spec ((.root) site)) (renderRootOwner ((.root) site)) ((.nominal) site)]+    languageError loc owner nominal =+      mkErr (locLine loc) MappedNominalLeafRequiresLanguage $+        owner <> " uses nominal '" <> nominal <> "'; nominal leaves require candidate language 6"+    renderRootOwner = \case+      RootCommandField aggregate command field -> "aggregate '" <> aggregate <> "' command '" <> command <> "' field '" <> field <> "'"+      RootEventField aggregate event field -> "aggregate '" <> aggregate <> "' event '" <> event <> "' field '" <> field <> "'"+      RootRegister aggregate register -> "aggregate '" <> aggregate <> "' register '" <> register <> "'"+      RootWorkqueueField workqueue field -> "workqueue '" <> workqueue <> "' payload field '" <> field <> "'"+      RootReadModelQueryInput readModel -> "readmodel '" <> readModel <> "' query input"+      RootReadModelQueryResult readModel -> "readmodel '" <> readModel <> "' query result"+      RootContractField contract event field -> "contract '" <> contract <> "' event '" <> event <> "' field '" <> field <> "'"+    candidateOnlyRoot = \case+      RootWorkqueueField {} -> True+      RootReadModelQueryInput {} -> True+      RootReadModelQueryResult {} -> True+      RootContractField {} -> True+      RootCommandField {} -> False+      RootEventField {} -> False+      RootRegister {} -> False+    maybeToList = maybe [] pure++nominalNamesInExpr :: ResolvedTypeExpr -> Set Name+nominalNamesInExpr =+  foldTypeExpr+    TypeExprAlgebra+      { onText = Set.empty,+        onInt = Set.empty,+        onInteger = Set.empty,+        onBool = Set.empty,+        onNatural = Set.empty,+        onTime = Set.empty,+        onJson = Set.empty,+        onOptional = id,+        onList = id,+        onMap = id,+        onKeyedMap = \key value -> Set.insert ((.name) key) value,+        onRef = const Set.empty,+        onNominal = Set.singleton . (.name)+      }++rootRefLoc :: Spec -> RootRef -> Loc+rootRefLoc spec = \case+  RootCommandField aggregateName commandName fieldName ->+    firstLoc+      [ (.loc) field+      | aggregate <- [value | NAggregate value <- (.nodes) spec, (.name) value == aggregateName],+        command <- (.commands) aggregate,+        (.name) command == commandName,+        field <- (.fields) command,+        (.name) field == fieldName+      ]+  RootEventField aggregateName eventName fieldName ->+    firstLoc+      [ (.loc) field+      | aggregate <- [value | NAggregate value <- (.nodes) spec, (.name) value == aggregateName],+        event <- (.events) aggregate,+        (.name) event == eventName,+        field <- case (.body) event of+          EventFields fields -> fields+          EventFromCommand commandName -> concat [(.fields) command | command <- (.commands) aggregate, (.name) command == commandName],+        (.name) field == fieldName+      ]+  RootRegister aggregateName registerName ->+    firstLoc [(.loc) register | aggregate <- [value | NAggregate value <- (.nodes) spec, (.name) value == aggregateName], register <- (.regs) aggregate, (.name) register == registerName]+  RootWorkqueueField workqueueName fieldName ->+    firstLoc [(.loc) field | workqueue <- [value | NWorkqueue value <- (.nodes) spec, (.name) value == workqueueName], field <- (.payload) workqueue, (.name) field == fieldName]+  RootReadModelQueryInput readModelName ->+    firstLoc [inputLoc | readModel <- [value | NReadModel value <- (.nodes) spec, (.name) value == readModelName], Just ReadModelQueryTypes {inputLoc} <- [(.queryTypes) readModel]]+  RootReadModelQueryResult readModelName ->+    firstLoc [resultLoc | readModel <- [value | NReadModel value <- (.nodes) spec, (.name) value == readModelName], Just ReadModelQueryTypes {resultLoc} <- [(.queryTypes) readModel]]+  RootContractField contractName eventName fieldName ->+    firstLoc+      [ (.loc) field+      | contract <- [value | NContract value <- (.nodes) spec, (.name) value == contractName],+        event <- (.events) contract,+        (.name) event == eventName,+        field <- (.fields) event,+        (.name) field == fieldName+      ]+  where+    firstLoc = \case+      loc : _ -> loc+      [] -> noLoc+ mappedGraphRules :: Spec -> TypeGraph -> [Diagnostic] mappedGraphRules spec graph =   concatMap declarationRules (Map.elems ((.declarations) graph))@@ -1349,7 +1577,14 @@             "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"]+        | not (defaultMatches graph ((.valueType) field) value) ->+            [ illTyped $ case (.valueType) field of+                RNominal leaf ->+                  "nominal fields do not accept literal on-missing defaults; write Optional "+                    <> (.name) leaf+                    <> " optional on-missing=null"+                _ -> "on-missing value does not match the field type or numeric bounds"+            ]       _ -> []       where         illTyped detail =@@ -1370,6 +1605,7 @@   | DefaultList   | DefaultMap   | DefaultEnum !(Set Name)+  | DefaultNominal   | DefaultOther  defaultMatches :: TypeGraph -> ResolvedTypeExpr -> OnMissing -> Bool@@ -1398,7 +1634,12 @@         onOptional = const DefaultOptional,         onList = const DefaultList,         onMap = const DefaultMap,-        onRef = referencedDefaultType graph+        onKeyedMap = \_ _ -> DefaultMap,+        onRef = referencedDefaultType graph,+        onNominal = \leaf -> case (.kind) leaf of+          NominalEnumLeaf constructors -> DefaultEnum (Set.fromList (map fst (NE.toList constructors)))+          NominalIdLeaf {} -> DefaultNominal+          NominalScalarLeaf {} -> DefaultNominal       }  referencedDefaultType :: TypeGraph -> MappedKey -> DefaultType@@ -1439,7 +1680,9 @@           onOptional = \child -> NullabilityFacts True ((.topNull) child || (.badOptional) child),           onList = nestedNonNull,           onMap = nestedNonNull,-          onRef = \key -> if mappedRefIsOpaque graph key then nullable else nonNull+          onKeyedMap = \_ -> nestedNonNull,+          onRef = \key -> if mappedRefIsOpaque graph key then nullable else nonNull,+          onNominal = const nonNull         }   where     nonNull = NullabilityFacts False False@@ -1590,16 +1833,19 @@      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))+        ++ case (.body) process of+          LegacyProcessBody input handle timer ->+            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))+          ReactionProcessBody reaction ->+            concatMap+              (\input -> constructorName "process input name" ((.name) input) ((.loc) input) ++ concatMap (\field -> fieldNameRule "process input field" ((.name) field) ((.loc) input)) ((.fields) input))+              (NE.toList ((.inputs) reaction))       where-        input = (.input) process-        handle = (.handle) process-        timer = (.timer) process         dispatchBindings dispatch = concatMap (bindingName "dispatch field binding" ((.loc) dispatch)) ((.fields) dispatch)      routerNames router =@@ -2084,9 +2330,9 @@  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 (NProcess p) = validateProcess languageContract typeGraphResult 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 (NContract contract) = validateContract languageContract spec 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@@ -2101,10 +2347,11 @@ 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 =+validateContract :: EffectiveLanguageContract -> Spec -> ContractNode -> [Diagnostic]+validateContract languageContract spec contract =   emptyContract     <> typeIdPrefixErrors+    <> declaredIdErrors     <> schemaVersionFloor     <> topicNames     <> duplicateEvents@@ -2139,6 +2386,30 @@         Just _ <- [contractIdDomainContractFor languageContract prefix],         Just reason <- [TypeID.checkPrefix prefix]       ]+    declaredIdErrors =+      [ mkErr (locLine ((.loc) field)) ContractIdUnknown $+          "contract '"+            <> (.name) contract+            <> "' event '"+            <> (.name) event+            <> "' field '"+            <> (.name) field+            <> "' names '"+            <> declaredName+            <> "', which "+            <> declaredIdProblem declaredName+      | event <- (.events) contract,+        field <- (.fields) event,+        CDeclaredId declaredName <- [(.valueType) field],+        all ((/= declaredName) . (.name)) ((.ids) spec)+      ]+    declaredIdProblem declaredName+      | any ((== declaredName) . (.name)) ((.enums) spec) = "is an enum; contract declared-ID fields must name a declared id"+      | any ((== declaredName) . (.name)) ((.nominalScalars) spec) = "is a nominal scalar; contract declared-ID fields must name a declared id"+      | any ((== declaredName) . rawMappedName) ((.mapped) spec) = "is a mapped declaration; contract declared-ID fields must name a declared id"+      | otherwise = "is not a declared id"+    rawMappedName MappedStructural {msName = name} = name+    rawMappedName MappedOpaque {moName = name} = name     schemaVersionFloor =       [ mkErr (locLine ((.loc) contract)) ContractSchemaVersionBelowMinimum $           "contract '" <> (.name) contract <> "' schemaVersion must be at least 1"@@ -3470,7 +3741,7 @@ -- | 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]+validateIntake languageContract i = concat [completeness, duplicateRows, inversions, dedupeVocabulary, delegatedPersistence, decodeVersionFloor, envelopeVocabulary, decodePosture, windows]   where     il = locLine ((.loc) i)     -- `decBodyStrict` reaches nothing but the pretty-printer: generated contract@@ -3512,6 +3783,14 @@             <> "'; expected PreferIntegrationMessageId, PreferSourceEventIdentity, or KafkaDeliveryIdentity"       | (.dedupePolicy) i `Set.notMember` intakeDedupePolicies       ]+    delegatedPersistence =+      [ mkErr il DelegatedInboxDedupeOnlyPersistence $+          "intake '"+            <> (.name) i+            <> "' delegates idempotence to its downstream state machine, so 'persist = dedupe-only' describes inbox storage that does not exist; remove the persist clause"+      | (.idempotence) i == IdemDelegated,+        (.persist) i == InkPersistDedupeOnly+      ]     decodeVersionFloor =       [ mkErr il IntakeDecodeSchemaVersionBelowMinimum $           "intake '" <> (.name) i <> "' decode schemaVersion must be at least 1"@@ -3604,8 +3883,43 @@     ]  -- | EP-3 rules for a process manager + its nested timer.-validateProcess :: EffectiveLanguageContract -> Spec -> ProcessNode -> [Diagnostic]-validateProcess languageContract spec p =+validateProcess :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> ProcessNode -> [Diagnostic]+validateProcess languageContract typeGraphResult spec p = case (.body) p of+  LegacyProcessBody input handle timer -> validateLegacyProcess languageContract spec p input handle timer+  ReactionProcessBody _ -> case typeGraphResult of+    Left _ -> []+    Right graph -> case ProcessReaction.checkProcessReaction languageContract graph spec p of+      Right _ -> []+      Left diagnostics -> map processReactionDiagnostic (NE.toList diagnostics)++processReactionDiagnostic :: ProcessReaction.ProcessReactionDiagnostic -> Diagnostic+processReactionDiagnostic diagnostic =+  mkErr (locLine ((.loc) diagnostic)) (processReactionDiagnosticCode ((.code) diagnostic)) ((.message) diagnostic)++processReactionDiagnosticCode :: ProcessReaction.ProcessReactionDiagnosticCode -> DiagnosticCode+processReactionDiagnosticCode = \case+  ProcessReaction.ProcessReactionUnknownInput -> ProcessReactionUnknownInput+  ProcessReaction.ProcessInputDuplicateDeclaration -> ProcessInputDuplicateDeclaration+  ProcessReaction.ProcessTimerDuplicateName -> ProcessTimerDuplicateName+  ProcessReaction.ProcessReactionGuardNotBoolean -> ProcessReactionGuardNotBoolean+  ProcessReaction.ProcessStateAccessUnsupported -> ProcessStateAccessUnsupported+  ProcessReaction.ProcessReactionInputUnhandled -> ProcessReactionInputUnhandled+  ProcessReaction.ProcessReactionDuplicateInput -> ProcessReactionDuplicateInput+  ProcessReaction.ProcessReactionOtherwiseMissing -> ProcessReactionOtherwiseMissing+  ProcessReaction.ProcessReactionOtherwiseUnreachable -> ProcessReactionOtherwiseUnreachable+  ProcessReaction.ProcessTimerPrefixCollision -> ProcessTimerPrefixCollision+  ProcessReaction.ProcessScheduleUnknownTimer -> ProcessScheduleUnknownTimer+  ProcessReaction.ProcessCancelUnknownTimer -> ProcessCancelUnknownTimer+  ProcessReaction.ProcessSchedulePayloadIncomplete -> ProcessSchedulePayloadIncomplete+  ProcessReaction.ProcessTimerPolicyMissing -> ProcessTimerPolicyMissing+  ProcessReaction.ProcessTimerPolicyUnused -> ProcessTimerPolicyUnused+  ProcessReaction.ProcessAcceptedArmRequiresEvent -> ProcessAcceptedArmRequiresEvent+  ProcessReaction.ProcessSilentArmMissing -> ProcessSilentArmMissing+  ProcessReaction.ProcessAcceptedArmUnverified -> ProcessAcceptedArmUnverified+  ProcessReaction.ProcessBindingTypeMismatch -> ProcessBindingTypeMismatch++validateLegacyProcess :: EffectiveLanguageContract -> Spec -> ProcessNode -> InputDecl -> HandleNode -> TimerNode -> [Diagnostic]+validateLegacyProcess languageContract spec p input handle timer =   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@@ -3618,7 +3932,7 @@             <> "' 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),+      | d <- (.dispatch) handle,         (.onAppended) ((.disposition) d) /= DAckOk       ] @@ -3662,9 +3976,8 @@     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+    inputFields = map (.name) ((.fields) input)+    timeFields = [(.name) f | f <- (.fields) input, (.valueType) f == Just "Time"]     pl = locLine ((.loc) p)      sagaCategoryRule =@@ -3681,11 +3994,11 @@        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) <> "'"+                  "timer '" <> (.name) timer <> "' fireAt field '" <> f <> "' is not a field of input '" <> (.name) input <> "'"               ]             else               [ mkErr (locLine ((.loc) timer)) ProcessFireAtNotInjected $-                  "timer '" <> (.name) timer <> "' fireAt references '" <> f <> "', which is not a declared :Time field of input '" <> (.name) ((.input) p) <> "'"+                  "timer '" <> (.name) timer <> "' fireAt references '" <> f <> "', which is not a declared :Time field of input '" <> (.name) input <> "'"               | f `notElem` timeFields               ] @@ -3694,13 +4007,13 @@     runtimeOwnedDispatchId =       [ mkErr pl ProcessDispatchIdSupplied $           "advance command '" <> (.advCommand) advance <> "' supplies a runtime-owned id field '" <> (.name) binding <> "'; remove it"-      | let advance = (.advance) ((.handle) p),+      | let advance = (.advance) handle,         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),+           | d <- (.dispatch) handle,              b <- (.fields) d,              (.name) b `elem` (["commandId", "id"] :: [Name])            ]@@ -3722,11 +4035,11 @@            | (.target) ((.fire) timer) `notElem` [(.agg) ((.saga) p), (.target) p]            ]         ++ resolveCommand pl "advance" ((.agg) ((.saga) p)) ((.advCommand) advance) ((.advFields) advance)-        ++ concatMap resolveDispatch ((.dispatch) ((.handle) p))+        ++ concatMap resolveDispatch ((.dispatch) handle)         ++ 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+               "process '" <> (.id) p <> "' schedules undeclared timer '" <> (.schedule) handle <> "'; declared timer is '" <> (.name) timer <> "'"+           | (.schedule) handle /= (.name) timer            ]         ++ [ mkErr pl ProcessUnresolvedRef $                "process '" <> (.id) p <> "' references undeclared projection table '" <> projection <> "'"@@ -3734,7 +4047,7 @@              projection `notElem` projectionTables            ]       where-        advance = (.advance) ((.handle) p)+        advance = (.advance) handle         fire = (.fire) timer         resolveDispatch dispatch =           resolveCommand@@ -3766,14 +4079,14 @@      correlateFieldRule =       [ mkErr pl ProcessKeyFieldUnknown $-          "correlate references 'input." <> (.field) ((.correlate) p) <> "' but input '" <> (.name) ((.input) p) <> "' does not declare that field"+          "correlate references 'input." <> (.field) ((.correlate) p) <> "' but input '" <> (.name) input <> "' 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),+      | dispatch <- (.dispatch) handle,         not (processKeyInScope ((.key) dispatch))       ]         ++ [ mkErr (locLine ((.loc) timer)) ProcessDispatchKeyUnresolved $@@ -3788,10 +4101,10 @@           Nothing -> False      bindingScopeRules =-      bindingRules pl "advance" inputFields ((.advFields) ((.advance) ((.handle) p)))+      bindingRules pl "advance" inputFields ((.advFields) ((.advance) handle))         ++ concatMap           (\dispatch -> bindingRules (locLine ((.loc) dispatch)) "dispatch" inputFields ((.fields) dispatch))-          ((.dispatch) ((.handle) p))+          ((.dispatch) handle)         ++ bindingRules           (locLine ((.loc) timer))           "timer fire"@@ -3837,7 +4150,7 @@         ((.loc) p)         ((.rejected) p)         [ ((.command) dispatch, (.loc) dispatch, (.disposition) dispatch)-        | dispatch <- (.dispatch) ((.handle) p)+        | dispatch <- (.dispatch) handle         ]      ambiguityRule =@@ -3854,7 +4167,7 @@       ]         ++ [ 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),+           | d <- (.dispatch) handle,              (.onDuplicate) ((.disposition) d) == DAckOk            ]
src/Keiro/Dsl/Workspace.hs view
@@ -498,6 +498,9 @@ instance (HasLocs a) => HasLocs [a] where   traverseLocs f = traverse (traverseLocs f) +instance (HasLocs a) => HasLocs (NonEmpty a) where+  traverseLocs f (value :| values) = (:|) <$> traverseLocs f value <*> traverse (traverseLocs f) values+ instance (HasLocs a) => HasLocs (Maybe a) where   traverseLocs f = traverse (traverseLocs f) @@ -1456,6 +1459,8 @@  instance HasLocs IdStrategy +instance HasLocs IdempotenceMode+ instance HasLocs InboxAction  instance HasLocs InkPersist@@ -1489,6 +1494,32 @@ instance HasLocs PolicyChoice  instance HasLocs Presence++instance HasLocs ProcessBody++instance HasLocs ReactionBody++instance HasLocs ReactionNode++instance HasLocs ReactionArm++instance HasLocs ArmGuard++instance HasLocs ArmBody++instance HasLocs AdvanceReaction++instance HasLocs FollowUp++instance HasLocs ScheduleNode++instance HasLocs ScheduleMode++instance HasLocs TimerPolicy++instance HasLocs ReactionTimerNode++instance HasLocs PayloadField  instance HasLocs ProcessNode
src/Keiro/Dsl/WorkspaceScaffold.hs view
@@ -73,7 +73,7 @@ import Keiro.Dsl.ExplainBindings (BindingHole (..), bindingHolesForService) import Keiro.Dsl.Goldens (GoldenPayload) import Keiro.Dsl.Grammar-import Keiro.Dsl.Harness (harnessForServiceWithGoldens, harnessProcess, harnessReadModelForService, harnessRouterForService, harnessWorkflow)+import Keiro.Dsl.Harness (harnessForServiceWithGoldens, harnessProcessForService, harnessReadModelForService, harnessRouterForService, harnessWorkflow) import Keiro.Dsl.HaskellName (currentGeneratedHaskellNamingEdition) import Keiro.Dsl.HaskellSourceMove (SourceMove (..), SourceMoveError, planSourceMoves) import Keiro.Dsl.IdDomain (idDomainIdentitiesForService)@@ -281,7 +281,7 @@      emittersFor node = case node of       NAggregate aggregate -> scaffoldAggregateForService ctx service aggregate <> harnessForServiceWithGoldens goldens ctx service aggregate-      NProcess process -> scaffoldProcess ctx process <> harnessProcess ctx process+      NProcess process -> scaffoldProcess ctx process <> harnessProcessForService ctx service process       NRouter router -> scaffoldRouterForService ctx service router <> harnessRouterForService ctx service router       NContract contract -> scaffoldContractForService ctx service contract       NIntake intake -> scaffoldIntake ctx intake
test/Keiro/Dsl/ConformanceBaseline.hs view
@@ -140,7 +140,7 @@       `shouldBe` ([] :: [Text])     forM_ ((.baselineCompiledSuites) baseline) $ \suite -> do       (.suiteRole) suite-        `shouldSatisfy` (`elem` ["stable-primary", "published-compatibility", "compatibility-proof", "version-independent"])+        `shouldSatisfy` (`elem` ["stable-primary", "candidate-primary", "published-compatibility", "compatibility-proof", "version-independent"])       validateSuiteLanguageOwnership baseline suite       (.suiteReason) suite `shouldSatisfy` (not . T.null . T.strip)       directory <- resolveRepoDirectory ("keiro-dsl" </> (.suiteDirectory) suite)@@ -194,6 +194,11 @@     definition <- requireRegisteredDefinition suite rawVersion     (.support) definition `shouldBe` Stable     (.maturity) definition `shouldBe` PublishedLanguage+  ("candidate-primary", Just rawVersion) -> do+    rawVersion `shouldBe` (.baselineAuthoringLanguageVersion) baseline+    definition <- requireRegisteredDefinition suite rawVersion+    (.support) definition `shouldBe` Candidate+    (.maturity) definition `shouldBe` CandidateLanguage   ("published-compatibility", Just rawVersion) -> do     rawVersion `shouldNotBe` (.baselineStableLanguageVersion) baseline     definition <- requireRegisteredDefinition suite rawVersion
test/Keiro/Dsl/FrontendProfiles.hs view
@@ -24,40 +24,44 @@                      (2, Just 1, "keiro-dsl/syntax-profile/2", "keiro-dsl/runtime-semantics/1"),                      (3, Just 2, "keiro-dsl/syntax-profile/2", "keiro-dsl/runtime-semantics/2"),                      (4, Just 3, "keiro-dsl/syntax-profile/3", "keiro-dsl/runtime-semantics/3"),-                     (5, Just 4, "keiro-dsl/syntax-profile/4", "keiro-dsl/runtime-semantics/4")+                     (5, Just 4, "keiro-dsl/syntax-profile/4", "keiro-dsl/runtime-semantics/4"),+                     (6, Just 5, "keiro-dsl/syntax-profile/5", "keiro-dsl/runtime-semantics/5")                    ]       map definitionCapabilities (NE.toList languageRegistry)         `shouldBe` [ [],                      [],                      [GeneratedIdDomainTypeIdV7, NominalEqualityV2],                      [GeneratedIdDomainTypeIdV7, NominalEqualityV2, ContractIdDomainTypeIdV7, StrictSpecSurfaceValidation],-                     [GeneratedIdDomainTypeIdV7, NominalEqualityV2, ContractIdDomainTypeIdV7, StrictSpecSurfaceValidation, ProjectionCatalogRuntime, TypedDomainCommandOutcomes, SeparatedProjectionQueryPolicy]+                     [GeneratedIdDomainTypeIdV7, NominalEqualityV2, ContractIdDomainTypeIdV7, StrictSpecSurfaceValidation, ProjectionCatalogRuntime, TypedDomainCommandOutcomes, SeparatedProjectionQueryPolicy],+                     [GeneratedIdDomainTypeIdV7, NominalEqualityV2, ContractIdDomainTypeIdV7, StrictSpecSurfaceValidation, ProjectionCatalogRuntime, TypedDomainCommandOutcomes, SeparatedProjectionQueryPolicy, DelegatedInboxRuntime, StructuralNominalLeaves]                    ]       map (runtimeProfileFoldSegments . (.runtimeSemanticsProfile)) (NE.toList languageRegistry)         `shouldBe` [ [],                      [],                      ["semantic-contract:keiro-dsl/runtime-semantics/2"],                      ["semantic-contract:keiro-dsl/runtime-semantics/2"],+                     ["semantic-contract:keiro-dsl/projection-catalog/1", "semantic-contract:keiro-dsl/runtime-semantics/2"],                      ["semantic-contract:keiro-dsl/projection-catalog/1", "semantic-contract:keiro-dsl/runtime-semantics/2"]                    ]       map (.support) (NE.toList languageRegistry)-        `shouldBe` [CompatibilityOnly, CompatibilityOnly, CompatibilityOnly, CompatibilityOnly, Stable]+        `shouldBe` [CompatibilityOnly, CompatibilityOnly, CompatibilityOnly, CompatibilityOnly, Stable, Candidate]       map (.maturity) (NE.toList languageRegistry)-        `shouldBe` [PublishedLanguage, PublishedLanguage, PublishedLanguage, PublishedLanguage, PublishedLanguage]+        `shouldBe` [PublishedLanguage, PublishedLanguage, PublishedLanguage, PublishedLanguage, PublishedLanguage, CandidateLanguage]       currentStableLanguageVersion `shouldBe` version 5-      currentAuthoringLanguageVersion `shouldBe` version 5+      currentAuthoringLanguageVersion `shouldBe` version 6       languageSupportForVersion (version 1) `shouldBe` Just CompatibilityOnly       languageSupportForVersion (version 2) `shouldBe` Just CompatibilityOnly       languageSupportForVersion (version 3) `shouldBe` Just CompatibilityOnly       languageSupportForVersion (version 4) `shouldBe` Just CompatibilityOnly       languageSupportForVersion (version 5) `shouldBe` Just Stable+      languageSupportForVersion (version 6) `shouldBe` Just Candidate       languageSupportForVersion (version 999999) `shouldBe` Nothing       [definition.version | definition <- NE.toList languageRegistry, (.support) definition == Stable]         `shouldBe` [currentStableLanguageVersion]       [definition.version | definition <- NE.toList languageRegistry, (.support) definition == Candidate]-        `shouldBe` []+        `shouldBe` [currentAuthoringLanguageVersion]       (NE.last languageRegistry).version `shouldBe` currentAuthoringLanguageVersion-      (.predecessor) (NE.last languageRegistry) `shouldBe` Just (version 4)+      (.predecessor) (NE.last languageRegistry) `shouldBe` Just (version 5)       forM_ (adjacent (NE.toList languageRegistry)) $ \(predecessor, successor) ->         forM_ allRuntimeCapabilities $ \capability ->           runtimeProfileHasCapability ((.runtimeSemanticsProfile) predecessor) capability@@ -72,10 +76,15 @@               DomainCommandOutcomeSyntax -> version 5               DeclarativeRouterSelectionSyntax -> version 5               SeparatedProjectionQueryPolicySyntax -> version 5+              DelegatedInboxSyntax -> version 6+              ProcessReactionSyntax -> version 6+              WorkqueueFifoHeadsSyntax -> version 6+              ContractDeclaredIdSyntax -> version 6+              KeyedMapSyntax -> version 6               FieldAliasSyntax -> version 4               _ -> version 2         languageFeatureMinimumVersion feature `shouldBe` minimumVersion-        forM_ [1, 2, 3, 4, 5] $ \versionNumber ->+        forM_ [1, 2, 3, 4, 5, 6] $ \versionNumber ->           languageSupportsFeature (version versionNumber) feature             `shouldBe` (version versionNumber >= minimumVersion) @@ -100,7 +109,7 @@      it "checks every real feature marker against the exact selected profile" $ do       forM_ featureCases $ \FeatureCase {feature, marker, body} ->-        forM_ [1, 2, 3, 4, 5] $ \versionNumber -> do+        forM_ [1, 2, 3, 4, 5, 6] $ \versionNumber -> do           let sourceName = "profile-" <> show versionNumber <> ".keiro"               source = preamble versionNumber <> body           case (languageSupportsFeature (version versionNumber) feature, parseSurfaceSource sourceName source) of@@ -116,7 +125,7 @@      it "keeps feature spellings inert in comments, strings, wire keys, and identifiers" $ do       inertBody <- readRepoText "keiro-dsl/test/fixtures/language-identifier-v1.keiro"-      forM_ [1, 2, 3, 4, 5] $ \versionNumber ->+      forM_ [1, 2, 3, 4, 5, 6] $ \versionNumber ->         parseSurfaceSource ("inert-" <> show versionNumber <> ".keiro") (preamble versionNumber <> inertBody)           `shouldSatisfy` isRight @@ -187,7 +196,11 @@     FeatureCase MappedConsumerSurfaceSyntax ":" mappedQueueFeatureBody,     FeatureCase MappedConsumerSurfaceSyntax "query" mappedQueryFeatureBody,     FeatureCase DeclarativeRouterSelectionSyntax "declarative" declarativeRouterFeatureBody,-    FeatureCase SeparatedProjectionQueryPolicySyntax "freshness" separatedProjectionQueryPolicyBody+    FeatureCase SeparatedProjectionQueryPolicySyntax "freshness" separatedProjectionQueryPolicyBody,+    FeatureCase DelegatedInboxSyntax "idempotence" delegatedInboxFeatureBody,+    FeatureCase ProcessReactionSyntax "reactions" processReactionFeatureBody,+    FeatureCase WorkqueueFifoHeadsSyntax "fifo-heads" (featureBody WorkqueueFifoHeadsSyntax),+    FeatureCase ContractDeclaredIdSyntax "ProfileId" (featureBody ContractDeclaredIdSyntax)   ]  featureBody :: LanguageFeature -> Text@@ -255,9 +268,81 @@       ]   DeclarativeRouterSelectionSyntax -> declarativeRouterFeatureBody   SeparatedProjectionQueryPolicySyntax -> separatedProjectionQueryPolicyBody+  DelegatedInboxSyntax -> delegatedInboxFeatureBody+  ProcessReactionSyntax -> processReactionFeatureBody+  WorkqueueFifoHeadsSyntax ->+    T.unlines+      [ "context profile",+        "workqueue profile_jobs {",+        "  queue logical = \"profile.jobs\"",+        "  derive physical = \"profile_jobs\" dlq = \"profile_jobs_dlq\" table = \"pgmq.q_profile_jobs\"",+        "  ordering fifo-heads",+        "  group key from profileId via raw",+        "  payload ProfileJob { profileId -> \"profile_id\" text required }",+        "  retry maxRetries = 3 delay = 5s dlq = on",+        "  disposition { storeFailure -> retry 5s commandRejected -> deadLetter decodeFailure -> deadLetter onCodecReject -> deadLetter }",+        "}"+      ]+  ContractDeclaredIdSyntax ->+    T.unlines+      [ "context profile",+        "id ProfileId prefix=profile",+        "contract profiles {",+        "  schemaVersion 1",+        "  discriminator kind",+        "  topic events \"profiles.events\"",+        "  event ProfileChanged on events { profileId: ProfileId }",+        "}"+      ]+  KeyedMapSyntax ->+    T.unlines+      [ "context profile",+        "id ProfileId prefix=profile",+        "mapped structural record ProfileMap {",+        "  haskell Example.ProfileMap ProfileMap",+        "  binding Example.ProfileMap.profileMapBinding version=1",+        "  canonical example.ProfileMap.v1",+        "  fixtures Example.ProfileMap.profileMapFixtures",+        "  entries as \"entries\" : Map[ProfileId] Text required",+        "}"+      ]  allFeatures :: [LanguageFeature]-allFeatures = [NominalBindingSyntax, IntegerScalarSyntax, TypedAggregateExpressionSyntax, ExplicitTransitionImplementationSyntax, FieldAliasSyntax, ProjectionCatalogSyntax, ExternalReadContractSyntax, MappedConsumerSurfaceSyntax, DomainCommandOutcomeSyntax, DeclarativeRouterSelectionSyntax, SeparatedProjectionQueryPolicySyntax]+allFeatures = [NominalBindingSyntax, IntegerScalarSyntax, TypedAggregateExpressionSyntax, ExplicitTransitionImplementationSyntax, FieldAliasSyntax, ProjectionCatalogSyntax, ExternalReadContractSyntax, MappedConsumerSurfaceSyntax, DomainCommandOutcomeSyntax, DeclarativeRouterSelectionSyntax, SeparatedProjectionQueryPolicySyntax, DelegatedInboxSyntax, ProcessReactionSyntax, WorkqueueFifoHeadsSyntax, ContractDeclaredIdSyntax, KeyedMapSyntax]++processReactionFeatureBody :: Text+processReactionFeatureBody =+  T.unlines+    [ "context profile",+      "process ProfileReaction",+      "  name \"profile-reaction\"",+      "  reactions version 1",+      "  input ProfileChanged { profileId:Text }",+      "  correlate input.profileId via idText",+      "  saga ProfileSaga category \"profileSaga\"",+      "  target Profile",+      "  projections [ ]",+      "  on ProfileChanged",+      "    no-action",+      "  dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, targetStreamName, occurrence)",+      "  rejected => halt",+      "  poison => halt"+    ]++delegatedInboxFeatureBody :: Text+delegatedInboxFeatureBody =+  T.unlines+    [ "context profile",+      "intake ProfileInbox {",+      "  contract ProfileContract",+      "  topic profiles",+      "  accept ProfileChanged",+      "  dedupe key messageId policy PreferIntegrationMessageId",+      "  idempotence delegated",+      "  decode { envelope strict-required lenient-optional body strict schemaVersion == 1 }",+      "  disposition { }",+      "}"+    ]  separatedProjectionQueryPolicyBody :: Text separatedProjectionQueryPolicyBody =
test/Main.hs view
@@ -18,14852 +18,15938 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as Map-import Data.Set qualified as Set-import Data.Text qualified as T-import Data.Text.Encoding qualified as TextEncoding-import Data.Text.IO qualified as TIO-import Data.Text.Lazy qualified as LazyText-import Data.Text.Lazy.Encoding qualified as LazyTextEncoding-import Data.Version (showVersion)-import Keiki.ProjectionDomain (matchesTextPattern)-import Keiro.Codec (Codec (..), EventType (..), decodeRaw)-import Keiro.Codec.IdDomain (IdDomainFailure (..), idDomainSampleText, idDomainTextPattern, parseKindIdV7Text, parseKindIdV7Value, typeIdV7Domain, validateIdDomainText)-import Keiro.Dsl.AggregateType-import Keiro.Dsl.BehaviorCoverage qualified as Behavior-import Keiro.Dsl.BehaviorSourceMap qualified as BehaviorSource-import Keiro.Dsl.CanonicalEncoding (foldFingerprint128)-import Keiro.Dsl.CodecCompare-import Keiro.Dsl.ConformanceBaseline (conformanceBaselineSpec)-import Keiro.Dsl.ConformancePackage-import Keiro.Dsl.ConsumerTypePlan-import Keiro.Dsl.CoordinationImpact-import Keiro.Dsl.Coverage qualified as Coverage-import Keiro.Dsl.Diff (Change (..), ChangeKind (..), CompatibilitySurface (..), CompatibilityVector (..), FamilyDiff (..), Label (..), MappedPersistedImpact (..), MappedPersistedSurface (..), NodeFamily, RolloutConstraint (..), SurfaceVerdict (..), defaultGate, deriveLabel, familyRegistry, gateWith, gatedBreaking, isAdvisory, isBreaking, verdictFor)-import Keiro.Dsl.Diff qualified as CheckedDiff-import Keiro.Dsl.DiffReport (Remedy (..), diffReport, diffReportWithImpacts, diffReportWithSemanticImpact, parseSurfaceName, remediationFor, renderExplainBlock, renderFinding, renderSemanticImpact)-import Keiro.Dsl.EventOutput-import Keiro.Dsl.ExplainBindings (BindingHole (..), BindingObligation (..), BindingObligationKind (..), bindingHoles, bindingObligations, bindingObligationsForService, renderBindingObligations)-import Keiro.Dsl.Expression-import Keiro.Dsl.FoldFingerprint (FoldSurfaceError (..))-import Keiro.Dsl.FoldFingerprint qualified as CheckedFold-import Keiro.Dsl.Frontend (FrontendErrorCode (..), FrontendFailure (..), LoweringFailure (..), LoweringFailureCode (..), lowerSurfaceDocument, parseSurfaceSource)-import Keiro.Dsl.FrontendCompatibility (frontendCompatibilitySpec)-import Keiro.Dsl.FrontendProfiles (frontendProfilesSpec)-import Keiro.Dsl.FrontendSurface (frontendSurfaceSpec)-import Keiro.Dsl.GeneratedHaskellLanguage (RewriteState (..), modernizeGeneratedHaskellSourceWithState)-import Keiro.Dsl.Goldens (GoldenEvidence (..), GoldenPayload (..), emitGoldenPayloads, goldenRelativePath, goldensForDiff)-import Keiro.Dsl.Grammar-import Keiro.Dsl.Grammar qualified as Grammar-import Keiro.Dsl.Harness (harnessFor, harnessForService, harnessForWithGoldens, harnessReadModel, harnessRouter, harnessWorkflow)-import Keiro.Dsl.HaskellImport-import Keiro.Dsl.HaskellSourceMove-import Keiro.Dsl.IdDomain (IdDomainContract (..), contractIdDomainContractFor, idDomainContractFor, idDomainIdentitiesForService)-import Keiro.Dsl.LanguageVersion-import Keiro.Dsl.Manifest (manifestDependencies, manifestDependenciesForService, moduleNameOf, renderManifest, renderManifestForService, renderManifestForServiceWithFacade)-import Keiro.Dsl.MappedCodecPlan-import Keiro.Dsl.MappedConsumer (ConsumerPlan (..), MappingIdentity (..), consumerPlan)-import Keiro.Dsl.MappedDiff (diffMapped)-import Keiro.Dsl.NominalType hiding (NominalInvalidHaskellSource, NominalInvalidIdPrefix, NominalInvalidIdentity, NominalMissingIngredient)-import Keiro.Dsl.Parser (parseSource, parseSourceDocument, parseSpec)-import Keiro.Dsl.PrettyPrint (renderSource, renderSpec, renderTransition)-import Keiro.Dsl.ProjectionMappedImpact qualified as ProjectionImpact-import Keiro.Dsl.ProjectionSupply-import Keiro.Dsl.ReadModelQueryContract (QueryContractDrift (..), QueryContractIdentity (..), QueryContractPosition (..), queryContractIdentities)-import Keiro.Dsl.ReadModelShape (canonicalShape, deriveShapeHash, registryNameFor, subscriptionNameFor)-import Keiro.Dsl.ReplayImpact (AggregateImpact (..), CatalogReplayImpact (..), ReplayImpact (..))-import Keiro.Dsl.ReplayImpact qualified as ReplayImpact-import Keiro.Dsl.RouterSelection qualified as RouterSelection-import Keiro.Dsl.Scaffold (Context (..), ModuleKind (..), ModuleRole (..), NominalGenerationOwner (..), NominalUseSite (..), ScaffoldModule (..), StructuralProjection (..), codecComparisonBanner, codecComparisonModule, defaultContext, firewallBreaches, genPrefixFor, generatedBanner, generatedBannerFor, generatedNominalModule, holePrefixFor, isGeneratedBannerLine, moduleRole, obsoleteGeneratedOutputHooks, planNominalGeneration, projectionSpecs, scaffoldAggregate, scaffoldAggregateForService, scaffoldContract, scaffoldContractForService, scaffoldIntake, scaffoldProcess, scaffoldProjectionCatalog, scaffoldPublisher, scaffoldReadModel, scaffoldReadModelForService, scaffoldRefusals, scaffoldReplayAudit, scaffoldRouter, scaffoldStructural, scaffoldWorkqueue, scaffoldWorkqueueForService, windowSeconds)-import Keiro.Dsl.ScaffoldRecord (GeneratedHaskellNamingEdition (..), ScaffoldModuleRoleRow (..), ScaffoldRecord (..), parseRecord, projectionCatalogFacts, projectionCatalogFactsForService, recordFileName, renderRecord)-import Keiro.Dsl.ScaffoldRun (GeneratedArtifactCategory (..), GeneratedArtifactImpact (..), GeneratedHaskellEditionImpact (..), GeneratedHaskellEditionUse (..), HoleUseForm (..), MappingDrift (..), QueryContractMigration (..), Refusal (..), ScaffoldReport (..), SourceLanguageDrift (..), StaleGeneratedEvidence (..), StaleModule (..), WriteDisposition (..), auditGeneratedHaskell, checkIndexedServiceDiagnostics, executeScaffold, executeScaffoldWithLanguage, executeServiceScaffold, executeServiceScaffoldWithRuntimePackage, executeServiceScaffoldWithRuntimePackageAndMigrations, executeServiceScaffoldWithRuntimePackageAndNameMigrations, planIndexedServiceScaffold, planIndexedServiceScaffoldWithRuntimePackage, planningRefusalDiagnostics, renderRefusals, renderScaffoldReport, renderSemanticImpactReport, scaffoldModules, scaffoldServiceModules)-import Keiro.Dsl.SemanticContract-import Keiro.Dsl.SemanticImpact-import Keiro.Dsl.SemanticImpact qualified as SemanticImpact-import Keiro.Dsl.ServiceHarness-import Keiro.Dsl.SidecarMigration-import Keiro.Dsl.SidecarNames-import Keiro.Dsl.Skeleton (skeletonFor, skeletonKinds)-import Keiro.Dsl.Source (SourcePoint (..), SourceSpan (..))-import Keiro.Dsl.SourceIndex-import Keiro.Dsl.TypeGraph-import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode (..), Severity (..), derivedQueueTrio, diagnosticCodeText, parseDiagnosticCode, renderDiagnostic, validateService, validateSpec)-import Keiro.Dsl.Workspace-import Keiro.Dsl.Workspace qualified as Workspace-import Keiro.Dsl.WorkspaceAdoption-import Keiro.Dsl.WorkspaceDiff hiding (diffWorkspaces)-import Keiro.Dsl.WorkspaceDiff qualified as CheckedWorkspaceDiff-import Keiro.Dsl.WorkspaceRecord-import Keiro.Dsl.WorkspaceRecord qualified as WorkspaceRecord-import Keiro.Dsl.WorkspaceScaffold-import Paths_keiro_dsl qualified as Package-import System.Directory (canonicalizePath, createDirectory, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getTemporaryDirectory, listDirectory, removeFile, removePathForcibly, renameFile, withCurrentDirectory)-import System.Environment (lookupEnv)-import System.Exit (ExitCode (..))-import System.FilePath (takeDirectory, takeExtension, takeFileName, (</>))-import System.IO (hClose, openTempFile)-import System.Process (readProcessWithExitCode)-import Test.Hspec hiding (Spec)-import Test.QuickCheck--resolvedFold :: Either FoldSurfaceError value -> value-resolvedFold = either (error . ("unexpected fold-surface failure in checked fixture: " <>) . show) id--aggregateFoldFingerprintForService :: CheckedService -> Aggregate -> T.Text-aggregateFoldFingerprintForService service aggregate = resolvedFold (CheckedFold.aggregateFoldFingerprintForService service aggregate)--aggregateFoldSurfaceForService :: CheckedService -> Aggregate -> T.Text-aggregateFoldSurfaceForService service aggregate = resolvedFold (CheckedFold.aggregateFoldSurfaceForService service aggregate)--aggregateFoldFingerprint :: Spec -> Aggregate -> T.Text-aggregateFoldFingerprint spec aggregate = aggregateFoldFingerprintForService (stableCheckedService spec) aggregate--aggregateFoldSurface :: Spec -> Aggregate -> T.Text-aggregateFoldSurface spec aggregate = aggregateFoldSurfaceForService (stableCheckedService spec) aggregate--legacyAggregateFoldFingerprint :: Spec -> Aggregate -> T.Text-legacyAggregateFoldFingerprint spec aggregate = aggregateFoldFingerprintForService (legacyCheckedService spec) aggregate--legacyAggregateFoldSurface :: Spec -> Aggregate -> T.Text-legacyAggregateFoldSurface spec aggregate = aggregateFoldSurfaceForService (legacyCheckedService spec) aggregate--diffServices :: CheckedService -> CheckedService -> [Change]-diffServices old new = resolvedFold (CheckedDiff.diffServices old new)--diffSources :: ParsedSource -> ParsedSource -> [Change]-diffSources old new = resolvedFold (CheckedDiff.diffSources old new)--diffSpecs :: Spec -> Spec -> [Change]-diffSpecs old new = diffServices (stableCheckedService old) (stableCheckedService new)--legacyDiffSpecs :: Spec -> Spec -> [Change]-legacyDiffSpecs old new = diffServices (legacyCheckedService old) (legacyCheckedService new)--diffWorkspaces :: WorkspaceSpec -> WorkspaceSpec -> [WorkspaceChange]-diffWorkspaces old new = resolvedFold (CheckedWorkspaceDiff.diffWorkspaces old new)--replayImpactSpecs :: Spec -> Spec -> ReplayImpact-replayImpactSpecs old new =-  resolvedFold (ReplayImpact.replayImpactServices (stableCheckedService old) (stableCheckedService new))--legacyReplayImpactSpecs :: Spec -> Spec -> ReplayImpact-legacyReplayImpactSpecs old new =-  resolvedFold (ReplayImpact.replayImpactServices (legacyCheckedService old) (legacyCheckedService new))--nominalEqualityIdentities :: Spec -> [T.Text]-nominalEqualityIdentities = nominalEqualityIdentitiesForService . stableCheckedService--stableCheckedService :: Spec -> CheckedService-stableCheckedService = checkedService stableSourceLanguage--stableSourceLanguage :: SourceLanguage-stableSourceLanguage =-  DeclaredLanguage-    { declaredLanguageVersion = currentStableLanguageVersion,-      languageVersionLoc = noLoc-    }--main :: IO ()-main = hspec $ do-  conformanceBaselineSpec-  frontendCompatibilitySpec-  frontendSurfaceSpec-  frontendProfilesSpec--  describe "mapped consumer surface" $ do-    it "parses and canonically round-trips Language 5 queue and query expressions as atomic forms" $ do-      source <- mappedConsumerSurfaceSource-      parsed <- case parseSource "<mapped-consumer>" source of-        Left failure -> expectationFailure (show failure) >> fail "unreachable"-        Right value -> pure value-      parseSource "<mapped-consumer-roundtrip>" (renderSource parsed) `shouldBe` Right parsed-      let spec = parsed.spec-      case [field | NWorkqueue workqueue <- (.nodes) spec, field <- (.payload) workqueue] of-        [field] -> do-          (.valueType) field `shouldBe` TypedQueueExpression (TList (TOptional (TRef "ArtifactInfo")))-          unLoc ((.loc) field) `shouldSatisfy` (> 0)-        fields -> expectationFailure ("unexpected mapped queue fields: " <> show fields)-      case [types | NReadModel readModel <- (.nodes) spec, Just types <- [(.queryTypes) readModel]] of-        [ReadModelQueryTypes {input, result}] -> do-          input `shouldBe` TRef "ArtifactInfo"-          result `shouldBe` TOptional (TRef "ArtifactLocation")-        queryPairs -> expectationFailure ("unexpected mapped query pairs: " <> show queryPairs)-      let missingInput = T.replace "  query input = ArtifactInfo\n" "" source-          missingResult = T.replace "  query result = Optional ArtifactLocation\n" "" source-      parseSource "<mapped-consumer-missing-input>" missingInput `shouldSatisfy` isLeft-      parseSource "<mapped-consumer-missing-result>" missingResult `shouldSatisfy` isLeft--    it "resolves nested queue and query roots and plans one deterministic consumer-facing Haskell type" $ do-      source <- mappedConsumerSurfaceSource-      spec <- parseInlineSpec "<mapped-consumer-graph>" source-      graph <- shouldResolveTypeGraph spec-      map renderUsePath (usePaths graph "ArtifactLocation")-        `shouldContain` [ "workqueue ArtifactJobs payload .jobData : ArtifactInfo [] optional .location : ArtifactLocation",-                          "readmodel ArtifactLookup query input : ArtifactInfo .location : ArtifactLocation",-                          "readmodel ArtifactLookup query result : ArtifactLocation optional"-                        ]-      planConsumerType graph (RList (ROptional (RRef (MappedKey "ArtifactInfo"))))-        `shouldBe` Right-          ConsumerTypePlan-            { haskellType = HaskellTypeOccurrence "[Maybe ArtifactInfo]",-              imports =-                [ ImportRequirement "artifact-domain" "Example.Artifact.Domain" "ArtifactInfo",-                  ImportRequirement "base" "Data.Maybe" "Maybe"-                ],-              dependencies = Set.fromList [MappedKey "ArtifactInfo", MappedKey "ArtifactKind", MappedKey "ArtifactLocation"]-            }-      unresolved <--        parseInlineSpec-          "<mapped-consumer-unresolved>"-          (T.replace "List (Optional ArtifactInfo)" "List (Optional MissingPayload)" source)-      case resolveTypeGraph unresolved of-        Left errors ->-          NE.toList errors-            `shouldSatisfy` any-              ( \case-                  TGUnresolvedConsumerRef owner missing loc ->-                    owner == "workqueue 'ArtifactJobs' payload field 'jobData'"-                      && missing == "MissingPayload"-                      && unLoc loc > 0-                  _ -> False-              )-        Right _ -> expectationFailure "unresolved mapped queue reference unexpectedly resolved"--    it "plans one recursive mapped codec algebra for consumer and structural boundaries" $ do-      source <- mappedConsumerSurfaceSource-      spec <- parseInlineSpec "<mapped-codec-plan>" source-      graph <- shouldResolveTypeGraph spec-      let expression = RList (ROptional (RRef (MappedKey "ArtifactInfo")))-      case planMappedCodec graph expression of-        Left failure -> expectationFailure (show failure)-        Right planned -> do-          (.authority) planned `shouldBe` Set.singleton (StructuralAuthority (MappedKey "ArtifactInfo"))-          renderMappedEncode graph ConsumerValueBoundary planned "payload.jobs"-            `shouldBe` "toJSON (map (\\item -> maybe Null (\\item -> encodeArtifactInfoMapped item) (item)) (payload.jobs))"-          renderMappedParse graph ConsumerValueBoundary planned-            `shouldBe` "\\value -> (parseJSON value :: Parser [Value]) >>= traverse (\\value -> case value of Null -> pure Nothing; other -> Just <$> parseArtifactInfoMapped other)"-          let references = consumerTypeReferences ((.consumerType) planned)-          case planHaskellImports (ImportEnvironment "Generated.Test.Queue" (Set.singleton "Payload") Set.empty) references of-            Left failure -> expectationFailure (show failure)-            Right importPlan ->-              renderConsumerType importPlan graph expression-                `shouldBe` Right (HaskellTypeOccurrence "[Maybe ArtifactInfo]")--    it "derives mapped projection impact from aggregate event authority and exposes heterogeneous boundaries" $ do-      source <- mappedConsumerSurfaceSource-      base <- parseInlineSpec "<mapped-consumer-projections>" source-      let projection = ProjectionSpec "artifact_view" (Just Eventual) "key" Nothing noLoc-          withInlineProjection node = case node of-            NAggregate aggregate -> NAggregate (aggregateWithProjection (Just projection) aggregate)-            NReadModel readModel@ReadModelNode {name = "ArtifactLookup"} ->-              NReadModel (readModelWithGroupAndObservedTargets (Just "artifact_group") ["artifact_target"] readModel)-            other -> other-          owner name sourceKind feed groupName targetNames replayPolicy =-            NProjectionOwner-              ProjectionOwnerNode-                { name = name,-                  sources = [sourceKind],-                  delivery = case feed of RmInline -> DeliveryInline; RmSubscription -> DeliverySubscription,-                  group = groupName,-                  targets = targetNames,-                  order = 1,-                  subscription = if feed == RmSubscription then Just (name <> "-subscription") else Nothing,-                  dedup = if feed == RmSubscription then Just (name <> "-dedup") else Nothing,-                  checkpointOnMissing = if feed == RmSubscription then [CheckpointFromBeginning] else [],-                  replay = replayPolicy,-                  loc = noLoc-                }-          target name = NProjectionTarget (ProjectionTargetNode name "public" name TargetClear [] noLoc)-          groupNode name targetName = NRebuildGroup (RebuildGroupNode name [targetName] [targetName] noLoc)-          disjointReadModel =-            NReadModel-              ReadModelNode-                { name = "DisjointLookup",-                  table = "disjoint_lookup",-                  schema = "public",-                  columns = [],-                  version = 1,-                  shape = "fixture",-                  freshness = FreshnessImmediate,-                  supply = LegacyReadModelSupply Eventual Nothing RmSubscription (Just "disjoint-lookup"),-                  group = Just "disjoint_group",-                  observedTargets = ["disjoint_target"],-                  backingTarget = Nothing,-                  queryTypes = Nothing,-                  loc = noLoc-                }-          spec =-            specWithNodes-              ( map withInlineProjection base.nodes-                  <> [ target "artifact_target",-                       target "disjoint_target",-                       groupNode "artifact_group" "artifact_target",-                       groupNode "disjoint_group" "disjoint_target",-                       owner "artifactProjection" (CatalogAggregate "Catalog") RmSubscription "artifact_group" ["artifact_target"] ProjectionReplayExplicit,-                       owner "liveProjection" (CatalogAggregate "Catalog") RmInline "disjoint_group" ["disjoint_target"] (ProjectionLiveOnly "live only"),-                       owner "categoryProjection" (CatalogCategory "artifact") RmSubscription "artifact_group" ["artifact_target"] ProjectionReplayExplicit,-                       owner "allProjection" CatalogAll RmInline "disjoint_group" ["disjoint_target"] (ProjectionLiveOnly "heterogeneous"),-                       disjointReadModel-                     ]-              )-              base-      impact <- semanticImpact <$> shouldResolveTypeGraph spec-      Set.fromList (mappedDeclarationConsumers impact (MappedKey "ArtifactLocation"))-        `shouldBe` Set.fromList-          [ AggregateConsumer "Catalog",-            WorkqueueConsumer "ArtifactJobs",-            ReadModelQueryConsumer "ArtifactLookup" MappedQueryInput,-            ReadModelQueryConsumer "ArtifactLookup" MappedQueryResult,-            DerivedProjectionConsumer (AggregateInlineProjectionConsumer "Catalog" "artifact_view"),-            DerivedProjectionConsumer (CatalogProjectionConsumer "artifactProjection" "Catalog"),-            DerivedProjectionConsumer (CatalogProjectionConsumer "liveProjection" "Catalog")-          ]-      Set.fromList ((.unsupportedProjectionSources) impact)-        `shouldBe` Set.fromList-          [ UnsupportedCatalogCategory "categoryProjection" "artifact",-            UnsupportedCatalogAll "allProjection"-          ]-      let projected = ProjectionImpact.projectionMappedImpact (stableCheckedService spec) impact-          locationConsumers = ProjectionImpact.projectionConsumersFor projected (MappedKey "ArtifactLocation")-      locationConsumers-        `shouldBe` Set.fromList-          [ AggregateInlineProjectionConsumer "Catalog" "artifact_view",-            CatalogProjectionConsumer "artifactProjection" "Catalog",-            CatalogProjectionConsumer "liveProjection" "Catalog"-          ]-      ( [ renderUsePath inheritedPath-        | ProjectionImpact.ProjectionMappedRoot derived declarationKey inheritedPath <- (.roots) projected,-          derived == CatalogProjectionConsumer "artifactProjection" "Catalog",-          declarationKey == MappedKey "ArtifactLocation"-        ]-        )-        `shouldBe` ["Catalog event ArtifactObserved .artifact : ArtifactInfo .location : ArtifactLocation"]-      ProjectionImpact.projectionOperationsFor projected (MappedKey "ArtifactLocation")-        `shouldBe` [ ProjectionImpact.ProjectionOperationalImpact-                       (AggregateInlineProjectionConsumer "Catalog" "artifact_view")-                       Nothing-                       (Set.singleton "artifact_view")-                       Set.empty-                       False-                       (ProjectionImpact.projectionAggregateSourceFingerprint spec "Catalog"),-                     ProjectionImpact.ProjectionOperationalImpact-                       (CatalogProjectionConsumer "artifactProjection" "Catalog")-                       (Just "artifact_group")-                       (Set.singleton "artifact_target")-                       (Set.singleton "ArtifactLookup")-                       True-                       (ProjectionImpact.projectionAggregateSourceFingerprint spec "Catalog"),-                     ProjectionImpact.ProjectionOperationalImpact-                       (CatalogProjectionConsumer "liveProjection" "Catalog")-                       (Just "disjoint_group")-                       (Set.singleton "disjoint_target")-                       (Set.singleton "DisjointLookup")-                       False-                       (ProjectionImpact.projectionAggregateSourceFingerprint spec "Catalog")-                   ]-      (.unsupported) projected-        `shouldBe` [ ProjectionImpact.UnsupportedProjectionImpact-                       (UnsupportedCatalogCategory "categoryProjection" "artifact")-                       "artifact_group"-                       (Set.singleton "artifact_target")-                       (Set.singleton "ArtifactLookup")-                       True,-                     ProjectionImpact.UnsupportedProjectionImpact-                       (UnsupportedCatalogAll "allProjection")-                       "disjoint_group"-                       (Set.singleton "disjoint_target")-                       (Set.singleton "DisjointLookup")-                       False-                   ]-      let baseFingerprint = ProjectionImpact.projectionAggregateSourceFingerprint spec "Catalog"-          wireChanged = mapMappedDeclaration "ArtifactLocation" changeProjectionMappedWire spec-          commandOnly = projectionEventWithoutGeometry spec-          commandOnlyChanged = mapMappedDeclaration "VendorGeometry" changeProjectionMappedWire commandOnly-      ProjectionImpact.projectionAggregateSourceFingerprint wireChanged "Catalog" `shouldNotBe` baseFingerprint-      ProjectionImpact.projectionAggregateSourceFingerprint commandOnlyChanged "Catalog"-        `shouldBe` ProjectionImpact.projectionAggregateSourceFingerprint commandOnly "Catalog"-      let generatedCatalog candidate =-            generatedTextEndingIn "ProjectionCatalog.hs" (scaffoldProjectionCatalog (defaultContext (candidate.context)) candidate)-          baseCatalog = generatedCatalog spec-      baseCatalog `shouldSatisfy` T.isInfixOf (T.pack (show baseFingerprint))-      generatedCatalog wireChanged `shouldNotBe` baseCatalog-      generatedCatalog commandOnlyChanged `shouldBe` generatedCatalog commandOnly-      let projectionChanges =-            [ kindOfChange change-            | change <- diffSpecs spec wireChanged,-              (.facet) (kindOfChange change) == "mapped-projection"-            ]-      map (.node) projectionChanges `shouldBe` ["Catalog", "artifactProjection", "liveProjection"]-      map (.subject) projectionChanges-        `shouldBe` [ "aggregate-projection:Catalog:artifact_view inherits ArtifactLocation",-                     "catalog-projection:artifactProjection:Catalog inherits ArtifactLocation",-                     "catalog-projection:liveProjection:Catalog inherits ArtifactLocation"-                   ]-      map (.paths) projectionChanges-        `shouldBe` replicate 3 ["Catalog event ArtifactObserved .artifact : ArtifactInfo .location : ArtifactLocation"]-      projectionChanges `shouldSatisfy` all ((== VAdvisory) . (.consumerBuild) . (.vector))-      map (.detail) projectionChanges-        `shouldSatisfy` any (T.isInfixOf "group=artifact_group, targets=[artifact_target], read-models=[ArtifactLookup], replayable=yes")-      [kindOfChange change | change <- diffSpecs commandOnly commandOnlyChanged, (.facet) (kindOfChange change) == "mapped-projection"]-        `shouldBe` []-      case ReplayImpact.catalogReplayImpactServices (stableCheckedService spec) (stableCheckedService wireChanged) of-        CatalogReplayAffected groups targets sources adapters invalidates -> do-          groups `shouldBe` Set.singleton "artifact_group"-          targets `shouldBe` Set.singleton "artifact_target"-          sources `shouldBe` Set.singleton "aggregate:Catalog"-          adapters `shouldBe` Set.singleton "artifactProjection"-          invalidates `shouldBe` True-        CatalogReplayNeutral -> expectationFailure "mapped event wire change was catalog replay-neutral"-      ReplayImpact.catalogReplayImpactServices (stableCheckedService commandOnly) (stableCheckedService commandOnlyChanged)-        `shouldBe` CatalogReplayNeutral-      let snapshot = semanticImpactSnapshot impact-      Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot--    it "lowers mapped queues and checked read-model query contracts" $ do-      source <- mappedConsumerSurfaceSource-      parsed <- case parseSource "<mapped-consumer-pending>" source of-        Left failure -> expectationFailure (show failure) >> fail "unreachable"-        Right value -> pure value-      let codes = map (.code) (validateService (checkedSource parsed))-      codes `shouldNotContain` [MappedReadModelLoweringPending]-      codes `shouldNotContain` [MappedQueueLoweringPending]-      case [workqueue | NWorkqueue workqueue <- (.nodes) ((.spec) parsed)] of-        [workqueue] -> do-          let modules = scaffoldWorkqueueForService (defaultContext (parsed.spec.context)) (checkedSource parsed) workqueue-              queue = generatedTextEndingIn "Queue.hs" modules-          queue `shouldSatisfy` T.isInfixOf "jobData :: ![Maybe ArtifactInfo]"-          queue `shouldSatisfy` T.isInfixOf "encodeArtifactInfoMapped"-          queue `shouldSatisfy` T.isInfixOf "explicitParseField (\\value -> (parseJSON value :: Parser [Value])"-          queue `shouldNotSatisfy` T.isInfixOf "Vendor.Geometry"-        workqueues -> expectationFailure ("unexpected workqueues: " <> show workqueues)-      case [readModel | NReadModel readModel <- (.nodes) ((.spec) parsed)] of-        [readModel] -> do-          let ctx = defaultContext (parsed.spec.context)-              modules = scaffoldReadModelForService ctx (checkedSource parsed) readModel-              contract = generatedTextEndingIn "QueryContract.hs" modules-              generatedReadModel = generatedTextEndingIn "ReadModel.hs" modules-              holes = T.intercalate "\n" [(.text) value | value <- modules, (.kind) value == HoleStub]-          contract `shouldSatisfy` T.isInfixOf "type ArtifactLookupQueryInput = ArtifactInfo"-          contract `shouldSatisfy` T.isInfixOf "type ArtifactLookupQueryResult = Maybe ArtifactLocation"-          contract `shouldSatisfy` T.isInfixOf "import Example.Artifact.Domain (ArtifactInfo, ArtifactLocation)"-          contract `shouldNotSatisfy` T.isInfixOf "Vendor.Geometry"-          generatedReadModel `shouldSatisfy` T.isInfixOf ".QueryContract (ArtifactLookupQueryInput, ArtifactLookupQueryResult)"-          generatedReadModel `shouldSatisfy` T.isInfixOf ".ReadModelHoles (artifactLookupQuery)"-          generatedReadModel `shouldNotSatisfy` T.isInfixOf "applyArtifactLookup"-          holes `shouldSatisfy` T.isInfixOf ".QueryContract (ArtifactLookupQueryInput, ArtifactLookupQueryResult)"-          holes `shouldNotSatisfy` T.isInfixOf "type ArtifactLookupQueryInput = ()"-        readModels -> expectationFailure ("unexpected mapped read models: " <> show readModels)-      queryContractIdentities ((.spec) parsed)-        `shouldBe` Right-          [ QueryContractIdentity-              { readModel = "ArtifactLookup",-                position = QueryInputConsumer,-                typeExpression = "ArtifactInfo",-                mappedDependencies = ["ArtifactInfo", "ArtifactKind", "ArtifactLocation"]-              },-            QueryContractIdentity-              { readModel = "ArtifactLookup",-                position = QueryResultConsumer,-                typeExpression = "Optional ArtifactLocation",-                mappedDependencies = ["ArtifactLocation"]-              }-          ]--    it "reports a retained legacy query hole until the application adopts the generated aliases" $-      withTempDirectory "keiro-dsl-query-contract-migration" $ \out -> do-        source <- mappedConsumerSurfaceSource-        parsed <- case parseSource "<mapped-query-migration>" source of-          Left failure -> expectationFailure (show failure) >> fail "unreachable"-          Right value -> pure value-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-        modules <- case planTestServiceScaffold ctx service of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right values -> pure values-        readModel <- case [value | NReadModel value <- (.nodes) spec] of-          [value] -> pure value-          values -> expectationFailure ("unexpected mapped read models: " <> show values) >> fail "unreachable"-        let typedHole = case [value | value <- modules, (.kind) value == HoleStub, "ReadModelHoles.hs" `T.isSuffixOf` T.pack (value.path)] of-              [value] -> value-              values -> error ("expected one query hole, got " <> show (map (.path) values))-            legacyHole = case [value | value <- scaffoldReadModel ctx readModel, (.kind) value == HoleStub] of-              [value] -> value-              values -> error ("expected one legacy query hole, got " <> show (map (.path) values))-            holePath = out </> typedHole.path-            run = executeServiceScaffold out False "mapped-query.keiro" ((.sourceLanguage) parsed) ctx service modules-        createDirectoryIfMissing True (takeDirectory holePath)-        TIO.writeFile holePath ((.text) legacyHole)-        TIO.writeFile-          (out </> recordFileName (spec.context))-          ( renderRecord-              ScaffoldRecord-                { specPath = "mapped-query.keiro",-                  moduleRoot = "",-                  layout = "prefixed",-                  sourceLanguage = (.sourceLanguage) parsed,-                  languageContract = checkedLanguageContract service,-                  namingEdition = IdiomaticNamingV2,-                  moduleRoles = [],-                  files = [],-                  mappings = [],-                  idDomains = [],-                  nominalEqualities = [],-                  bindingObligations = [],-                  behaviorRequirements = [],-                  projectionCatalogFacts = [],-                  queryContractBaseline = False,-                  queryContracts = [],-                  routerSelections = [],-                  semanticImpact = Nothing-                }-          )-        first <- run >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure-        (.queryContractBaselineUnavailable) first `shouldBe` True-        (.queryContractMigrations) first-          `shouldBe` [ QueryContractMigration-                         { owner = "ArtifactLookup",-                           path = typedHole.path,-                           requiredImport = "import Generated.ConsumerDemo.ArtifactLookup.QueryContract (ArtifactLookupQueryInput, ArtifactLookupQueryResult)"-                         }-                     ]-        renderScaffoldReport first `shouldSatisfy` any (T.isInfixOf "remove the local QueryInput/QueryResult type aliases")-        renderScaffoldReport first `shouldSatisfy` any (T.isInfixOf "baseline unavailable")-        currentLedger <- TIO.readFile ((.recordPath) first)-        case parseRecord currentLedger of-          Just record -> do-            (.queryContractBaseline) record `shouldBe` True-            length ((.queryContracts) record) `shouldBe` 2-          Nothing -> expectationFailure "standalone query-contract ledger did not parse"-        case filter ("query-contract " `T.isPrefixOf`) (T.lines currentLedger) of-          row : _ -> parseRecord (currentLedger <> row <> "\n") `shouldBe` Nothing-          [] -> expectationFailure "expected standalone query-contract rows"-        TIO.writeFile holePath ((.text) typedHole)-        second <- run >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure-        (.queryContractMigrations) second `shouldBe` []-        [disposition | (value, disposition) <- (.dispositions) second, value.path == typedHole.path]-          `shouldBe` [Skipped]--        changedParsed <- case parseSource "<mapped-query-drift>" (T.replace "query result = Optional ArtifactLocation" "query result = ArtifactLocation" source) of-          Left failure -> expectationFailure (show failure) >> fail "unreachable"-          Right value -> pure value-        let changedService = checkedSource changedParsed-        changedModules <- case planTestServiceScaffold ctx changedService of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right values -> pure values-        third <--          executeServiceScaffold out False "mapped-query.keiro" ((.sourceLanguage) changedParsed) ctx changedService changedModules-            >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure-        (.queryContractDrift) third-          `shouldSatisfy` \case-            [QueryContractDrift {key = ("ArtifactLookup", QueryResultConsumer)}] -> True-            _ -> False-        renderScaffoldReport third `shouldSatisfy` any (T.isInfixOf "query contract drift: 1")--        let withoutQuerySource =-              T.unlines-                [ line-                | line <- T.lines source,-                  not ("  query input =" `T.isPrefixOf` line),-                  not ("  query result =" `T.isPrefixOf` line)-                ]-        withoutQueryParsed <- case parseSource "<mapped-query-removed>" withoutQuerySource of-          Left failure -> expectationFailure (show failure) >> fail "unreachable"-          Right value -> pure value-        let withoutQueryService = checkedSource withoutQueryParsed-        withoutQueryModules <- case planTestServiceScaffold ctx withoutQueryService of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right values -> pure values-        fourth <--          executeServiceScaffold out False "mapped-query.keiro" ((.sourceLanguage) withoutQueryParsed) ctx withoutQueryService withoutQueryModules-            >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure-        length ((.queryContractDrift) fourth) `shouldBe` 2-        removedLedger <- TIO.readFile ((.recordPath) fourth)-        case parseRecord removedLedger of-          Just record -> do-            (.queryContractBaseline) record `shouldBe` True-            (.queryContracts) record `shouldBe` []-          Nothing -> expectationFailure "removed query-contract ledger did not parse"--    it "plans and records the same typed query contract across workspace members" $-      withTempDirectory "keiro-dsl-mapped-query-workspace" $ \out -> do-        plan <- shouldPlanWorkspace "test/fixtures/mapped-readmodel-workspace/service.keiro-workspace"-        let contractRows =-              [ (scaffoldModule, provenance)-              | (scaffoldModule, provenance) <- (.modules) plan,-                "QueryContract.hs" `T.isSuffixOf` T.pack ((.path) scaffoldModule)-              ]-        case contractRows of-          [(contract, MemberOwned owner)] -> do-            owner `shouldBe` "readmodel.keiro"-            (.text) contract `shouldSatisfy` T.isInfixOf "type AccountSummaryQueryInput = AccountLookup"-            (.text) contract `shouldSatisfy` T.isInfixOf "type AccountSummaryQueryResult = Maybe AccountSummary"-          values -> expectationFailure ("unexpected workspace query contracts: " <> show values)-        report <- executeWorkspaceScaffold out False plan >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure-        (.queryContractMigrations) report `shouldBe` []-        recordText <- TIO.readFile ((.recordPath) report)-        case parseWorkspaceRecord recordText of-          Just record -> do-            (.queryContractBaseline) record `shouldBe` True-            length ((.queryContracts) record) `shouldBe` 2-          Nothing -> expectationFailure "workspace query-contract ledger did not parse"--  describe "complete mapped surfaces" $ do-    it "projects exact queue, query, event, snapshot, and replayable projection consequences" $ do-      aggregateSpec <- specOf "test/fixtures/semantic-impact.keiro"-      queueSpec <- specOf "test/fixtures/mapped-workqueue.keiro"-      querySpec <- specOf "test/fixtures/mapped-readmodel.keiro"-      projectionSpec <- specOf "test/fixtures/projection-catalog.keiro"-      let aggregateImpact = semanticImpactForSpec aggregateSpec-          queueImpact = semanticImpactForSpec queueSpec-          queryImpact = semanticImpactForSpec querySpec-          projectionImpact = semanticImpactForSpec projectionSpec-          consequences impact declaration = Map.findWithDefault Set.empty (MappedKey declaration) ((.declarationConsequences) impact)-      consequences aggregateImpact "CommandPayload"-        `shouldBe` Set.singleton (MappedConsumerBuild (AggregateConsumer "Alpha"))-      consequences aggregateImpact "EventPayload"-        `shouldBe` Set.fromList [MappedConsumerBuild (AggregateConsumer "Alpha"), MappedPrivateEventHistory "Alpha"]-      consequences aggregateImpact "RegisterPayload"-        `shouldBe` Set.fromList [MappedConsumerBuild (AggregateConsumer "Alpha"), MappedSnapshotHydration "Alpha"]-      consequences queueImpact "JobPayload"-        `shouldBe` Set.fromList [MappedConsumerBuild (WorkqueueConsumer "mapped_jobs"), MappedWorkqueueHistory "mapped_jobs"]-      consequences queryImpact "AccountLookup"-        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "account_summary" MappedQueryInput), MappedQueryApi "account_summary" MappedQueryInput]-      consequences queryImpact "AccountSummary"-        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "account_summary" MappedQueryResult), MappedQueryApi "account_summary" MappedQueryResult]-      consequences projectionImpact "OrderPayload"-        `shouldBe` Set.fromList-          [ MappedConsumerBuild (AggregateConsumer "Orders"),-            MappedPrivateEventHistory "Orders",-            MappedConsumerBuild (DerivedProjectionConsumer (CatalogProjectionConsumer "order_summary_writer" "Orders")),-            MappedProjectionHandlerReview (CatalogProjectionConsumer "order_summary_writer" "Orders"),-            MappedProjectionRebuild (CatalogProjectionConsumer "order_summary_writer" "Orders") "reporting"-          ]--    it "reports every surface independently without inventing Json or heterogeneous typed roots" $ do-      queueSpec <- specOf "test/fixtures/mapped-workqueue.keiro"-      querySpec <- specOf "test/fixtures/mapped-readmodel.keiro"-      projectionSpec <- specOf "test/fixtures/projection-catalog.keiro"-      queueCoverage <- shouldResolveCoverage "mapped-workqueue.keiro" queueSpec-      queryCoverage <- shouldResolveCoverage "mapped-readmodel.keiro" querySpec-      projectionCoverage <- shouldResolveCoverage "projection-catalog.keiro" projectionSpec-      (.workqueuePayloads) ((.summary) queueCoverage)-        `shouldBe` Coverage.CoverageCounts 2 2 0 1-      (.readModelQueryInputs) ((.summary) queryCoverage)-        `shouldBe` Coverage.CoverageCounts 1 1 0 0-      (.readModelQueryResults) ((.summary) queryCoverage)-        `shouldBe` Coverage.CoverageCounts 1 1 0 0-      (.projectionTypedConsumers) ((.summary) projectionCoverage)-        `shouldBe` Coverage.CoverageCounts 3 0 3 0-      map (.consumer) [root | root <- (.roots) queryCoverage, (.surface) root `elem` [Coverage.ReadModelQueryInput, Coverage.ReadModelQueryResult]]-        `shouldBe` ["read-model-query:account_summary:input", "read-model-query:account_summary:result"]-      map (.surface) ((.unsupportedSurfaces) projectionCoverage)-        `shouldContain` ["projection-category:audit_writer:audit"]--    it "places one deterministic surface/consumer/root/path fact set behind the service facade" $ do-      services <- mapM checkedServiceOf ["test/fixtures/mapped-workqueue.keiro", "test/fixtures/mapped-readmodel.keiro", "test/fixtures/projection-catalog.keiro"]-      let facts = concatMap serviceConformanceFactValues services-          surfaceFacts = [(key, value) | (key, value) <- facts, "mapped-surface/" `T.isPrefixOf` key]-          keys = map fst surfaceFacts-      length keys `shouldBe` Set.size (Set.fromList keys)-      keys `shouldSatisfy` any (T.isInfixOf "/workqueue-payload/workqueue:mapped_jobs/JobPayload/workqueue mapped_jobs payload .job : JobPayload")-      keys `shouldSatisfy` any (T.isInfixOf "/read-model-query-input/read-model-query:account_summary:input/AccountLookup/readmodel account_summary query input : AccountLookup")-      keys `shouldSatisfy` any (T.isInfixOf "/projection-event-consumer/catalog-projection:order_summary_writer:Orders/OrderPayload/Orders event OrderRecorded .orderPayload : OrderPayload")-      map snd surfaceFacts `shouldSatisfy` any (T.isInfixOf "workqueue-history:mapped_jobs")-      map snd surfaceFacts `shouldSatisfy` any (T.isInfixOf "projection-rebuild:catalog-projection:order_summary_writer:Orders:reporting")--    it "keeps predecessor facades byte-stable while extending the Language 5 facade" $ do-      published <- checkedServiceOf "test/fixtures/semantic-impact.keiro"-      candidate <- checkedServiceOf "test/fixtures/mapped-workqueue.keiro"-      serviceConformanceFactKeys published-        `shouldSatisfy` all (not . T.isPrefixOf "mapped-surface/")-      serviceConformanceFactKeys candidate-        `shouldSatisfy` any (T.isPrefixOf "mapped-surface/")--    it "detects replay policy and observer relation drift without fabricating mapped declaration changes" $ do-      projectionSpec <- specOf "test/fixtures/projection-catalog.keiro"-      let makeLiveOnly node = case node of-            NProjectionOwner owner@ProjectionOwnerNode {name = "order_summary_writer"} ->-              NProjectionOwner (projectionOwnerWithReplay (ProjectionLiveOnly "candidate is intentionally live-only") owner)-            other -> other-          moveObserver node = case node of-            NReadModel readModel@ReadModelNode {name = "catalogAudit"} ->-              NReadModel (readModelWithObservedTargets ["order_summary"] readModel)-            other -> other-          liveOnly = specWithNodes (map makeLiveOnly projectionSpec.nodes) projectionSpec-          observerMoved = specWithNodes (map moveObserver projectionSpec.nodes) projectionSpec-          liveDeltas = CheckedDiff.mappedSemanticImpact projectionSpec liveOnly-          observerDeltas = CheckedDiff.mappedSemanticImpact projectionSpec observerMoved-      map (.declaration) liveDeltas `shouldBe` [MappedKey "OrderPayload", MappedKey "SharedReference"]-      map (.currentConsequences) liveDeltas-        `shouldSatisfy` all (maybe False (not . any (\case MappedProjectionRebuild (CatalogProjectionConsumer "order_summary_writer" "Orders") _ -> True; _ -> False) . Set.toList))-      map (.declaration) observerDeltas `shouldBe` [MappedKey "OrderPayload", MappedKey "SharedReference"]-      map (.currentEvidence) observerDeltas-        `shouldSatisfy` any (maybe False (any (maybe False (T.isInfixOf "catalogAudit") . (.operation)) . Set.toList))-      diffMapped projectionSpec liveOnly `shouldBe` []--  describe "mapped surface ledger" $ do-    it "round-trips complete evidence, treats aggregate-only history as unknown, and rejects corrupt known tags" $ do-      spec <- specOf "test/fixtures/semantic-impact.keiro"-      let snapshot = semanticImpactSnapshotForSpec spec-          legacy = semanticImpactSnapshotWithoutEvidence snapshot-          declaration = MappedKey "EventPayload"-          report = semanticImpactReport (Just legacy) snapshot [declaration]-          encoded = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode snapshot))-          corrupt = T.replace "\"surface\":\"aggregate-command\"" "\"surface\":\"future-surface\"" encoded-      Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot-      Aeson.decode (Aeson.encode legacy) `shouldBe` Just legacy-      (.deltas) report `shouldSatisfy` \case-        [delta] -> (.previousEvidence) delta == Nothing && (.currentEvidence) delta /= Nothing-        _ -> False-      renderSemanticImpactReport report `shouldSatisfy` any (T.isInfixOf "previous roots: baseline unavailable")-      corrupt `shouldNotBe` encoded-      (Aeson.decode (LazyTextEncoding.encodeUtf8 (LazyText.fromStrict corrupt)) :: Maybe SemanticImpactSnapshot) `shouldBe` Nothing--  describe "mapped compatibility vectors" $ do-    it "keeps queue, query, event, snapshot, and projection consequences orthogonal" $ do-      queueSpec <- specOf "test/fixtures/mapped-workqueue.keiro"-      querySpec <- specOf "test/fixtures/mapped-readmodel.keiro"-      aggregateSpec <- specOf "test/fixtures/semantic-impact.keiro"-      projectionSpec <- specOf "test/fixtures/projection-catalog.keiro"-      let changeQueue node = case node of-            NWorkqueue queue ->-              NWorkqueue (workqueueWithPayload [if field.name == "job" then wqFieldWithValueType (TypedQueueExpression (TRef "JobMetadata")) field else field | field <- queue.payload] queue)-            other -> other-          queueChanged = specWithNodes (map changeQueue queueSpec.nodes) queueSpec-          changeQuery node = case node of-            NReadModel readModel@ReadModelNode {queryTypes = Just queryPair} ->-              NReadModel (readModelWithQueryTypes (Just (ReadModelQueryTypes (TRef "TenantKey") queryPair.result queryPair.inputLoc queryPair.resultLoc)) readModel)-            other -> other-          queryChanged = specWithNodes (map changeQuery querySpec.nodes) querySpec-          findKind predicate changes = case [kindOfChange change | change <- changes, predicate (kindOfChange change)] of-            value : _ -> value-            [] -> error "expected mapped compatibility finding"-          queueKind = findKind ((== WqPayloadFieldChanged) . (.code)) (diffSpecs queueSpec queueChanged)-          queryKind = findKind ((== ReadModelQueryInputChanged) . (.code)) (diffSpecs querySpec queryChanged)-          eventKind = findKind ((== "mapped-event") . (.facet)) [change | mutation <- mappedWireMutations aggregateSpec, change <- diffSpecs aggregateSpec ((.mmCandidate) mutation)]-          snapshotKind = findKind ((== "mapped-register") . (.facet)) [change | mutation <- mappedWireMutations aggregateSpec, change <- diffSpecs aggregateSpec ((.mmCandidate) mutation)]-          projectionChanged = mapMappedDeclaration "OrderPayload" changeProjectionMappedWire projectionSpec-          projectionKind = findKind ((== "mapped-projection") . (.facet)) (diffSpecs projectionSpec projectionChanged)-      (.mappedConsequences) queueKind-        `shouldBe` Set.fromList [MappedConsumerBuild (WorkqueueConsumer "mapped_jobs"), MappedWorkqueueHistory "mapped_jobs"]-      (.privateHistoryRead) (queueKind.vector) `shouldBe` VNotApplicable-      (.consumerBuild) (queueKind.vector) `shouldBe` VBreaking-      (.mappedConsequences) queryKind-        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "account_summary" MappedQueryInput), MappedQueryApi "account_summary" MappedQueryInput]-      (.snapshotHydration) (queryKind.vector) `shouldBe` VNotApplicable-      (.mappedConsequences) eventKind `shouldSatisfy` Set.member (MappedPrivateEventHistory "Alpha")-      (.mappedConsequences) snapshotKind `shouldSatisfy` Set.member (MappedSnapshotHydration "Alpha")-      (.mappedConsequences) projectionKind `shouldSatisfy` Set.member (MappedProjectionHandlerReview (CatalogProjectionConsumer "order_summary_writer" "Orders"))-      (.mappedConsequences) projectionKind-        `shouldSatisfy` Set.member (MappedProjectionRebuild (CatalogProjectionConsumer "order_summary_writer" "Orders") "reporting")--  describe "mapped surface qualification" $ do-    it "selects every explicit and derived surface from one integrated Language 5 authority" $ do-      service <- checkedServiceOf "test/fixtures/projection-catalog.keiro"-      workspace <- shouldComposeWorkspace "test/fixtures/projection-catalog.keiro-workspace"-      coverage <- shouldResolveCoverage "projection-catalog.keiro" (checkedSpec service)-      let impact = semanticImpactForSpec (checkedSpec service)-          qualify name = qualifyMappedSurface impact (MappedKey name)-          orderPayload = qualify "OrderPayload"-          sharedReference = qualify "SharedReference"-          qualificationPayload = qualify "QualificationPayload"-          queueMetadata = qualify "QueueMetadata"-          queryCriteria = qualify "QueryCriteria"-          qualificationResult = qualify "QualificationResult"-          registerState = qualify "RegisterState"-          unused = qualify "UnusedQualification"-          standaloneSnapshot = semanticImpactSnapshot impact-      standaloneSnapshot `shouldBe` semanticImpactSnapshotForSpec ((.mergedSpec) workspace)-      Aeson.decode (Aeson.encode standaloneSnapshot) `shouldBe` Just standaloneSnapshot-      (.consumers) orderPayload-        `shouldBe` Set.fromList-          [ AggregateConsumer "Orders",-            DerivedProjectionConsumer (CatalogProjectionConsumer "order_summary_writer" "Orders")-          ]-      Set.map (.rootKind) ((.evidence) orderPayload)-        `shouldBe` Set.fromList [MappedCommandFieldRoot, MappedEventFieldRoot, MappedProjectionEventRoot]-      (.consequences) orderPayload-        `shouldSatisfy` Set.member (MappedProjectionRebuild (CatalogProjectionConsumer "order_summary_writer" "Orders") "reporting")-      (.consumers) sharedReference-        `shouldBe` Set.fromList-          [ AggregateConsumer "Orders",-            AggregateConsumer "Shipments",-            WorkqueueConsumer "qualification_jobs",-            DerivedProjectionConsumer (CatalogProjectionConsumer "order_summary_writer" "Orders"),-            DerivedProjectionConsumer (CatalogProjectionConsumer "shipment_writer" "Shipments")-          ]-      (.consumers) qualificationPayload `shouldBe` Set.singleton (WorkqueueConsumer "qualification_jobs")-      (.consequences) qualificationPayload-        `shouldBe` Set.fromList [MappedConsumerBuild (WorkqueueConsumer "qualification_jobs"), MappedWorkqueueHistory "qualification_jobs"]-      (.consumers) queueMetadata `shouldBe` Set.singleton (WorkqueueConsumer "qualification_jobs")-      (.consumers) queryCriteria `shouldBe` Set.singleton (ReadModelQueryConsumer "order_inline" MappedQueryInput)-      (.consequences) queryCriteria-        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "order_inline" MappedQueryInput), MappedQueryApi "order_inline" MappedQueryInput]-      (.consumers) qualificationResult `shouldBe` Set.singleton (ReadModelQueryConsumer "order_inline" MappedQueryResult)-      (.consequences) qualificationResult-        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "order_inline" MappedQueryResult), MappedQueryApi "order_inline" MappedQueryResult]-      (.consumers) registerState `shouldBe` Set.singleton (AggregateConsumer "Orders")-      (.consequences) registerState-        `shouldBe` Set.fromList [MappedConsumerBuild (AggregateConsumer "Orders"), MappedSnapshotHydration "Orders"]-      (.consumers) unused `shouldBe` Set.empty-      (.evidence) unused `shouldBe` Set.empty-      (.consequences) unused `shouldBe` Set.empty-      (.workqueuePayloads) ((.summary) coverage) `shouldBe` Coverage.CoverageCounts 4 1 3 1-      (.readModelQueryInputs) ((.summary) coverage) `shouldBe` Coverage.CoverageCounts 1 0 1 0-      (.readModelQueryResults) ((.summary) coverage) `shouldBe` Coverage.CoverageCounts 1 0 1 0-      (.projectionTypedConsumers) ((.summary) coverage) `shouldBe` Coverage.CoverageCounts 3 0 3 0-      map (.surface) ((.unsupportedSurfaces) coverage)-        `shouldContain` ["projection-category:audit_writer:audit"]--    it "aligns every mapping diff with the authority's exact consequence set" $ do-      service <- checkedServiceOf "test/fixtures/projection-catalog.keiro"-      let spec = checkedSpec service-          impact = semanticImpactForSpec spec-          opaqueMutation name = mapMappedDeclaration name changeProjectionMappedWire spec-          mutations =-            [ ("OrderPayload", opaqueMutation "OrderPayload"),-              ("SharedReference", opaqueMutation "SharedReference"),-              ("QualificationPayload", addMappedOptionalTextField "QualificationPayload" "addedNote" spec),-              ("QueueMetadata", opaqueMutation "QueueMetadata"),-              ("QueryCriteria", opaqueMutation "QueryCriteria"),-              ("QualificationResult", opaqueMutation "QualificationResult"),-              ("RegisterState", opaqueMutation "RegisterState"),-              ("UnusedQualification", opaqueMutation "UnusedQualification")-            ]-          actualConsequences candidate =-            Set.unions-              [ (.mappedConsequences) (kindOfChange change)-              | change <- diffServices service (checkedServiceWithSpec candidate service)-              ]-          expectedConsequences name = (.consequences) (qualifyMappedSurface impact (MappedKey name))-      forM_ mutations $ \(name, candidate) ->-        actualConsequences candidate `shouldBe` expectedConsequences name--    it "pins exact generated locality and keeps it constant under unrelated workspace growth" $ do-      service <- checkedServiceOf "test/fixtures/projection-catalog.keiro"-      grown <- shouldComposeWorkspace "test/fixtures/projection-catalog-grown.keiro-workspace"-      let spec = checkedSpec service-          ctx = defaultContext (spec.context)-          baseline = scaffoldServiceModules ctx service-          modulesFor candidate = scaffoldServiceModules ctx (checkedServiceWithSpec candidate service)-          deltaFor candidate = generatedTreeDelta baseline (modulesFor candidate)-          opaqueDelta name = deltaFor (mapMappedDeclaration name changeProjectionMappedWire spec)-          structuralDelta = deltaFor (addMappedOptionalTextField "QualificationPayload" "addedNote" spec)-          structuralPaths =-            Set.fromList-              [ "Generated/CatalogDemo/QualificationJobs/Queue.hs",-                "Generated/CatalogDemo/Structural/Shape/QualificationPayload.hs",-                "Generated/CatalogDemo/StructuralConformance.hs"-              ]-          projectionPaths =-            Set.fromList-              [ "Generated/CatalogDemo/ProjectionCatalog.hs",-                "Generated/CatalogDemo/StructuralConformance.hs"-              ]-          registerPaths =-            Set.fromList-              [ "Generated/CatalogDemo/Orders/Transducer.hs",-                "Generated/CatalogDemo/StructuralConformance.hs"-              ]-          serviceOnly = Set.singleton "Generated/CatalogDemo/StructuralConformance.hs"-          assertExact delta paths = do-            (.changedPaths) delta `shouldBe` paths-            (.addedPaths) delta `shouldBe` Set.empty-            (.removedPaths) delta `shouldBe` Set.empty-      assertExact structuralDelta structuralPaths-      assertExact (opaqueDelta "OrderPayload") projectionPaths-      assertExact (opaqueDelta "SharedReference") projectionPaths-      assertExact (opaqueDelta "RegisterState") registerPaths-      forM_ ["QueueMetadata", "QueryCriteria", "QualificationResult", "UnusedQualification"] $ \name ->-        assertExact (opaqueDelta name) serviceOnly-      let grownCandidate = mapWorkspaceSpec (mapMappedDeclaration "OrderPayload" changeProjectionMappedWire) grown-      grownBaselinePlan <- shouldPlanWorkspaceSpec grown-      grownCandidatePlan <- shouldPlanWorkspaceSpec grownCandidate-      let grownDelta = generatedTreeDelta (map fst ((.modules) grownBaselinePlan)) (map fst ((.modules) grownCandidatePlan))-      (.changedPaths) grownDelta `shouldBe` (.changedPaths) (opaqueDelta "OrderPayload")-      (.addedPaths) grownDelta `shouldBe` Set.empty-      (.removedPaths) grownDelta `shouldBe` Set.empty--    it "keeps Language 5 syntax gated and predecessor service facades unchanged" $ do-      candidate <- checkedServiceOf "test/fixtures/projection-catalog.keiro"-      published <- checkedServiceOf "test/fixtures/consumer-types.keiro"-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      let candidateKeys = serviceConformanceFactKeys candidate-          candidateValues = map snd (serviceConformanceFactValues candidate)-      candidateKeys `shouldSatisfy` any (T.isPrefixOf "mapped-surface/")-      length candidateKeys `shouldBe` Set.size (Set.fromList candidateKeys)-      candidateValues `shouldSatisfy` any (T.isInfixOf "workqueue-history:qualification_jobs")-      candidateValues `shouldSatisfy` any (T.isInfixOf "query-api:order_inline:input")-      candidateValues `shouldSatisfy` any (T.isInfixOf "projection-handler-review:catalog-projection:order_summary_writer:Orders")-      serviceConformanceFactKeys published `shouldSatisfy` all (not . T.isPrefixOf "mapped-surface/")-      parseSource "<published-mapped-surfaces>" (T.replace "language keiro-dsl 5" "language keiro-dsl 4" source)-        `shouldSatisfy` isLeft--  describe "language support" $ do-    it "serializes support from the registered version and decodes older records" $ do-      v1Contract <- maybe (expectationFailure "missing v1 contract" >> fail "unreachable") pure (effectiveLanguageContractForVersion =<< languageVersion 1)-      v4Contract <- maybe (expectationFailure "missing v4 contract" >> fail "unreachable") pure (effectiveLanguageContractForVersion =<< languageVersion 4)-      v5Contract <- maybe (expectationFailure "missing v5 contract" >> fail "unreachable") pure (effectiveLanguageContractForVersion =<< languageVersion 5)-      effectiveLanguageSupport v1Contract `shouldBe` CompatibilityOnly-      effectiveLanguageSupport v4Contract `shouldBe` CompatibilityOnly-      effectiveLanguageSupport v5Contract `shouldBe` Stable-      Aeson.toJSON v5Contract-        `shouldBe` object-          [ "languageVersion" .= (5 :: Int),-            "runtimeSemantics" .= ("keiro-dsl/runtime-semantics/4" :: T.Text),-            "languageSupport" .= ("stable" :: T.Text)-          ]-      Aeson.eitherDecode "{\"languageVersion\":1,\"runtimeSemantics\":\"keiro-dsl/runtime-semantics/1\"}"-        `shouldBe` Right v1Contract--    it "reports stable and compatibility-only support through source inspection" $ do-      (stableCode, stableOut, stableErr) <- runKeiroDsl ["inspect", "test/fixtures/projection-catalog.keiro", "--format=json"]-      stableCode `shouldBe` ExitSuccess-      stableErr `shouldBe` ""-      stableOut `shouldContain` "\"languageVersion\":5"-      stableOut `shouldContain` "\"languageSupport\":\"stable\""-      (predecessorCode, predecessorOut, predecessorErr) <- runKeiroDsl ["inspect", "test/fixtures/contract-v4.keiro", "--format=json"]-      predecessorCode `shouldBe` ExitSuccess-      predecessorErr `shouldBe` ""-      predecessorOut `shouldContain` "\"languageVersion\":4"-      predecessorOut `shouldContain` "\"languageSupport\":\"compatibility-only\""-      (compatibilityCode, compatibilityOut, compatibilityErr) <- runKeiroDsl ["inspect", "test/fixtures/language-v1.keiro", "--format=json"]-      compatibilityCode `shouldBe` ExitSuccess-      compatibilityErr `shouldBe` ""-      compatibilityOut `shouldContain` "\"languageVersion\":1"-      compatibilityOut `shouldContain` "\"languageSupport\":\"compatibility-only\""--    it "surfaces non-stable contracts and enforces a released minimum language" $ do-      let legacyPath = "test/fixtures/language-legacy.keiro"-          stablePath = "test/fixtures/projection-catalog.keiro"-      (legacyCode, legacyOut, legacyErr) <- runKeiroDsl ["check", legacyPath]-      legacyCode `shouldBe` ExitSuccess-      legacyOut `shouldBe` "OK\n"-      legacyErr `shouldContain` "language contract: effective keiro-dsl 1 (legacy-unversioned, compatibility-only, runtime semantics keiro-dsl/runtime-semantics/1)"-      legacyErr `shouldContain` "language-5 strict spec-surface validation is not applied"--      (stableCode, stableOut, stableErr) <- runKeiroDsl ["check", stablePath]-      stableCode `shouldBe` ExitSuccess-      stableOut `shouldBe` "OK\n"-      stableErr `shouldBe` ""--      (floorCode, floorOut, floorErr) <- runKeiroDsl ["check", legacyPath, "--min-language", "4"]-      floorCode `shouldBe` ExitFailure 1-      floorOut `shouldBe` ""-      floorErr `shouldContain` "language-legacy.keiro:1: error[LanguageVersionBelowMinimum]"-      floorErr `shouldContain` "effective language version 1 (legacy-unversioned) is below the required minimum 4"--      (metCode, metOut, _) <- runKeiroDsl ["check", legacyPath, "--min-language", "1"]-      metCode `shouldBe` ExitSuccess-      metOut `shouldBe` "OK\n"--      (unsupportedCode, _, unsupportedErr) <- runKeiroDsl ["check", legacyPath, "--min-language", "9"]-      unsupportedCode `shouldBe` ExitFailure 1-      unsupportedErr `shouldContain` "supported versions: 1, 2, 3, 4, 5"--    it "attributes a workspace language floor to its manifest and every member" $ do-      let v1Member = T.unlines ["language keiro-dsl 1", "context language-floor"]-      withInlineWorkspace-        "keiro-dsl-language-floor"-        ( "language-floor",-          [ ("domain/a.keiro", v1Member),-            ("domain/b.keiro", v1Member)-          ]-        )-        $ \root _ _ -> do-          let manifest = root </> "service.keiro-workspace"-          (floorCode, floorOut, floorErr) <- runKeiroDsl ["check", manifest, "--min-language", "4"]-          floorCode `shouldBe` ExitFailure 1-          floorOut `shouldBe` ""-          floorErr `shouldContain` (manifest <> ":1: error[LanguageVersionBelowMinimum]")-          floorErr `shouldContain` "domain/a.keiro:1: note: member selects effective language version 1"-          floorErr `shouldContain` "domain/b.keiro:1: note: member selects effective language version 1"-          floorErr `shouldContain` "workspace, 0 legacy-unversioned member(s)"--          (metCode, metOut, _) <- runKeiroDsl ["check", manifest, "--min-language", "1"]-          metCode `shouldBe` ExitSuccess-          metOut `shouldBe` "OK\n"--  describe "warning enforcement" $ do-    it "round-trips every stable diagnostic code spelling" $ do-      forM_ [minBound .. maxBound] $ \diagnosticCode ->-        parseDiagnosticCode (diagnosticCodeText diagnosticCode) `shouldBe` Just diagnosticCode--    it "fails only the warnings selected by invocation policy" $ do-      let fixture = "test/fixtures/deny-unlogged.keiro"-          warningText = "warning[WqUnloggedDurability]"-          summaryText = "check: 1 warning(s) escalated to failure (denied: WqUnloggedDurability)"--      (plainCode, plainOut, plainErr) <- runKeiroDsl ["check", fixture]-      plainCode `shouldBe` ExitSuccess-      plainOut `shouldBe` "OK\n"-      plainErr `shouldContain` warningText-      plainErr `shouldNotContain` "escalated to failure"--      (allCode, allOut, allErr) <- runKeiroDsl ["check", fixture, "--deny-warnings"]-      allCode `shouldBe` ExitFailure 1-      allOut `shouldBe` ""-      allErr `shouldContain` warningText-      allErr `shouldContain` summaryText--      (selectedCode, selectedOut, selectedErr) <- runKeiroDsl ["check", fixture, "--deny", "WqUnloggedDurability"]-      selectedCode `shouldBe` ExitFailure 1-      selectedOut `shouldBe` ""-      selectedErr `shouldContain` warningText-      selectedErr `shouldContain` summaryText--      (otherCode, otherOut, otherErr) <- runKeiroDsl ["check", fixture, "--deny", "WireSchemaVersionMismatch"]-      otherCode `shouldBe` ExitSuccess-      otherOut `shouldBe` "OK\n"-      otherErr `shouldContain` warningText-      otherErr `shouldNotContain` "escalated to failure"--      (unionCode, unionOut, unionErr) <--        runKeiroDsl-          [ "check",-            fixture,-            "--deny-warnings",-            "--deny",-            "WireSchemaVersionMismatch,WqUnloggedDurability"-          ]-      unionCode `shouldBe` ExitFailure 1-      unionOut `shouldBe` ""-      unionErr `shouldContain` warningText-      unionErr `shouldContain` summaryText--      (unknownCode, _, unknownErr) <- runKeiroDsl ["check", fixture, "--deny", "NotACode"]-      unknownCode `shouldBe` ExitFailure 1-      unknownErr `shouldContain` "unknown diagnostic code `NotACode`"-      unknownErr `shouldContain` "warning[Code]"--    -- A denial that can never match reads like a CI gate and is not one. Every-    -- code `check` cannot emit is refused at the point of use instead.-    it "refuses a denial of a code check can never emit" $ do-      let fixture = "test/fixtures/deny-unlogged.keiro"--      (diffCode, _, diffErr) <- runKeiroDsl ["check", fixture, "--deny", "EvtFieldWireKeyChanged"]-      diffCode `shouldBe` ExitFailure 1-      diffErr `shouldContain` "`EvtFieldWireKeyChanged` is emitted by `keiro-dsl diff`"-      diffErr `shouldContain` "would never match"--      -- Rejection survives being hidden inside a comma-separated list.-      (mixedCode, _, mixedErr) <--        runKeiroDsl ["check", fixture, "--deny", "WqUnloggedDurability,WorkflowShapeChanged"]-      mixedCode `shouldBe` ExitFailure 1-      mixedErr `shouldContain` "`WorkflowShapeChanged` is emitted by `keiro-dsl diff`"--      (codecCode, _, codecErr) <- runKeiroDsl ["check", fixture, "--deny", "CodecCompareDifference"]-      codecCode `shouldBe` ExitFailure 1-      codecErr `shouldContain` "generated codec-comparison path"--      -- A coverage code is emittable, but only by an invocation that asks for-      -- the coverage pass, so the requirement is stated rather than ignored.-      (noPassCode, _, noPassErr) <- runKeiroDsl ["check", fixture, "--deny", "CoverageOpaqueSurface"]-      noPassCode `shouldBe` ExitFailure 1-      noPassErr `shouldContain` "add --coverage-report FILE or drop the code"--      -- CoverageOpaqueGateExceeded is the error --fail-on-opaque itself raises,-      -- never a warning, so denying it is a silent no-op in every invocation —-      -- with or without the coverage pass it is refused with the real spelling.-      withTempDirectory "keiro-dsl-gate-exceeded-deny" $ \out -> do-        (gateCode, _, gateErr) <--          runKeiroDsl-            ["check", fixture, "--coverage-report", out </> "coverage.json", "--deny", "CoverageOpaqueGateExceeded"]-        gateCode `shouldBe` ExitFailure 1-        gateErr `shouldContain` "pass --fail-on-opaque instead of denying it"-      (gateNoPassCode, _, gateNoPassErr) <- runKeiroDsl ["check", fixture, "--deny", "CoverageOpaqueGateExceeded"]-      gateNoPassCode `shouldBe` ExitFailure 1-      gateNoPassErr `shouldContain` "pass --fail-on-opaque instead of denying it"--    it "applies the warning policy to structural-coverage findings" $ do-      withTempDirectory "keiro-dsl-coverage-deny" $ \out -> do-        let fixture = "test/fixtures/structural-conformance.keiro"-            coveragePath = out </> "coverage.json"-            reportPath = out </> "nested" </> "dir" </> "check.json"-            warningText = "warning[CoverageOpaqueSurface]"--        -- Reporting-only by default: the finding prints and the check passes.-        (plainCode, _, plainErr) <--          runKeiroDsl ["check", fixture, "--coverage-report", coveragePath]-        plainCode `shouldBe` ExitSuccess-        plainErr `shouldContain` warningText-        plainErr `shouldNotContain` "escalated to failure"--        -- Before ExecPlan 199 this combination exited 0 with the warning printed.-        (deniedCode, _, deniedErr) <--          runKeiroDsl-            [ "check",-              fixture,-              "--coverage-report",-              coveragePath,-              "--deny-warnings",-              -- The nested path also proves --report-out creates parent dirs.-              "--report-out",-              reportPath-            ]-        deniedCode `shouldBe` ExitFailure 1-        deniedErr `shouldContain` warningText-        deniedErr `shouldContain` "escalated to failure (denied: CoverageOpaqueSurface)"--        report <- decodeJsonValue reportPath-        jsonField "ok" report `shouldBe` Just (Aeson.Bool False)-        (jsonField "summary" report >>= jsonField "deniedWarnings") `shouldBe` Just (Aeson.Number 1)-        case jsonField "diagnostics" report of-          Just (Aeson.Array entries) ->-            [entry | entry <- toList entries, jsonField "code" entry == Just (Aeson.String "CoverageOpaqueSurface")]-              `shouldSatisfy` \matching -> case matching of-                entry : _ ->-                  jsonField "severity" entry == Just (Aeson.String "warning")-                    && jsonField "denied" entry == Just (Aeson.Bool True)-                [] -> False-          other -> expectationFailure ("expected diagnostics array, got " <> show other)--        -- Selecting the code by name gates it just as precisely.-        (selectedCode, _, _) <--          runKeiroDsl-            ["check", fixture, "--coverage-report", coveragePath, "--deny", "CoverageOpaqueSurface"]-        selectedCode `shouldBe` ExitFailure 1--    it "spells warning severity the same way in both JSON reports" $ do-      withTempDirectory "keiro-dsl-severity-vocabulary" $ \out -> do-        let coveragePath = out </> "coverage.json"-        (exitCode, _, _) <--          runKeiroDsl-            ["check", "test/fixtures/structural-conformance.keiro", "--coverage-report", coveragePath]-        exitCode `shouldBe` ExitSuccess-        coverage <- decodeJsonValue coveragePath-        case jsonField "findings" coverage of-          Just (Aeson.Array entries) -> case toList entries of-            entry : _ -> jsonField "severity" entry `shouldBe` Just (Aeson.String "warning")-            [] -> expectationFailure "coverage report had no findings"-          other -> expectationFailure ("expected findings array, got " <> show other)--    it "writes the machine report when a workspace is refused during composition" $ do-      withTempDirectory "keiro-dsl-workspace-refusal-report" $ \out -> do-        let reportPath = out </> "made" </> "up" </> "refusal.json"-        (exitCode, stdoutText, _) <--          runKeiroDsl-            [ "check",-              "test/fixtures/workspace-dup-decl/service.keiro-workspace",-              "--report-out",-              reportPath-            ]-        exitCode `shouldBe` ExitFailure 1-        stdoutText `shouldBe` ""-        report <- decodeJsonValue reportPath-        jsonField "schema" report `shouldBe` Just (Aeson.String "keiro-dsl/check-report/1")-        jsonField "kind" report `shouldBe` Just (Aeson.String "workspace")-        jsonField "ok" report `shouldBe` Just (Aeson.Bool False)-        -- No service graph was composed, so there is no language contract.-        jsonField "language" report `shouldBe` Just Aeson.Null-        case jsonField "diagnostics" report of-          Just (Aeson.Array entries) -> case toList entries of-            entry : _ -> do-              jsonField "code" entry `shouldBe` Just (Aeson.String "WorkspaceDuplicateDeclaration")-              jsonField "severity" entry `shouldBe` Just (Aeson.String "error")-            [] -> expectationFailure "workspace refusal report had no diagnostics"-          other -> expectationFailure ("expected diagnostics array, got " <> show other)--    it "applies the same warning policy to a composed workspace" $ do-      warningSource <- readTestText "test/fixtures/deny-unlogged.keiro"-      withInlineWorkspace-        "keiro-dsl-warning-policy"-        ("warning-policy", [("domain/jobs.keiro", warningSource)])-        $ \root _ _ -> do-          let manifest = root </> "service.keiro-workspace"-          (plainCode, plainOut, plainErr) <- runKeiroDsl ["check", manifest]-          plainCode `shouldBe` ExitSuccess-          plainOut `shouldBe` "OK\n"-          plainErr `shouldContain` "domain/jobs.keiro:4: warning[WqUnloggedDurability]"--          (deniedCode, deniedOut, deniedErr) <- runKeiroDsl ["check", manifest, "--deny", "WqUnloggedDurability"]-          deniedCode `shouldBe` ExitFailure 1-          deniedOut `shouldBe` ""-          deniedErr `shouldContain` "domain/jobs.keiro:4: warning[WqUnloggedDurability]"-          deniedErr `shouldContain` "check: 1 warning(s) escalated to failure (denied: WqUnloggedDurability)"--  describe "check report" $ do-    it "writes exact check report JSON bytes and retains semantic assertions" $ do-      withTempDirectory "keiro-dsl-check-report-floor" $ \out -> do-        let reportPath = out </> "report.json"-        (exitCode, stdoutText, _) <--          runKeiroDsl-            [ "check",-              "test/fixtures/language-legacy.keiro",-              "--min-language",-              "4",-              "--report-out",-              reportPath-            ]-        exitCode `shouldBe` ExitFailure 1-        stdoutText `shouldBe` ""-        reportBytes <- BS.readFile reportPath-        assertMatchesByteGolden "test/fixtures/check-report/legacy-min-language.golden.json" reportBytes-        report <- decodeJsonValue reportPath-        jsonField "schema" report `shouldBe` Just (Aeson.String "keiro-dsl/check-report/1")-        jsonField "kind" report `shouldBe` Just (Aeson.String "source")-        jsonField "ok" report `shouldBe` Just (Aeson.Bool False)-        (jsonField "language" report >>= jsonField "stable") `shouldBe` Just (Aeson.Bool False)-        (jsonField "summary" report >>= jsonField "errors") `shouldBe` Just (Aeson.Number 1)-        case jsonField "diagnostics" report of-          Just (Aeson.Array entries) -> case toList entries of-            entry : _ -> do-              jsonField "code" entry `shouldBe` Just (Aeson.String "LanguageVersionBelowMinimum")-              jsonField "severity" entry `shouldBe` Just (Aeson.String "error")-              jsonField "line" entry `shouldBe` Just (Aeson.Number 1)-            [] -> expectationFailure "check report had no diagnostics"-          other -> expectationFailure ("expected diagnostics array, got " <> show other)--    it "marks denied warnings without changing their severity" $ do-      withTempDirectory "keiro-dsl-check-report-deny" $ \out -> do-        let deniedPath = out </> "denied.json"-            allowedPath = out </> "allowed.json"-            fixture = "test/fixtures/deny-unlogged.keiro"-        (deniedCode, _, _) <- runKeiroDsl ["check", fixture, "--deny-warnings", "--report-out", deniedPath]-        deniedCode `shouldBe` ExitFailure 1-        deniedReport <- decodeJsonValue deniedPath-        jsonField "ok" deniedReport `shouldBe` Just (Aeson.Bool False)-        (jsonField "summary" deniedReport >>= jsonField "deniedWarnings") `shouldBe` Just (Aeson.Number 1)-        case jsonField "diagnostics" deniedReport of-          Just (Aeson.Array entries) -> case toList entries of-            entry : _ -> do-              jsonField "severity" entry `shouldBe` Just (Aeson.String "warning")-              jsonField "denied" entry `shouldBe` Just (Aeson.Bool True)-            [] -> expectationFailure "denied-warning report had no diagnostics"-          other -> expectationFailure ("expected diagnostics array, got " <> show other)--        (allowedCode, _, _) <- runKeiroDsl ["check", fixture, "--report-out", allowedPath]-        allowedCode `shouldBe` ExitSuccess-        allowedReport <- decodeJsonValue allowedPath-        jsonField "ok" allowedReport `shouldBe` Just (Aeson.Bool True)-        (jsonField "summary" allowedReport >>= jsonField "deniedWarnings") `shouldBe` Just (Aeson.Number 0)-        case jsonField "diagnostics" allowedReport of-          Just (Aeson.Array entries) -> case toList entries of-            entry : _ -> jsonField "denied" entry `shouldBe` Just (Aeson.Bool False)-            [] -> expectationFailure "allowed-warning report had no diagnostics"-          other -> expectationFailure ("expected diagnostics array, got " <> show other)--    it "reports canonical workspace members and writes nothing before parse success" $ do-      withTempDirectory "keiro-dsl-check-report-workspace" $ \out -> do-        let workspacePath = out </> "workspace.json"-            parseFailurePath = out </> "parse-failure.json"-            unregisteredPath = out </> "language-unregistered.keiro"-        (workspaceCode, _, _) <- runKeiroDsl ["check", canonicalWorkspacePath, "--report-out", workspacePath]-        workspaceCode `shouldBe` ExitSuccess-        workspaceReport <- decodeJsonValue workspacePath-        jsonField "kind" workspaceReport `shouldBe` Just (Aeson.String "workspace")-        jsonField "ok" workspaceReport `shouldBe` Just (Aeson.Bool True)-        (jsonField "language" workspaceReport >>= jsonField "sourceForm") `shouldBe` Just (Aeson.String "workspace-composed")-        case jsonField "members" workspaceReport of-          Just (Aeson.Array members) -> length members `shouldBe` 3-          other -> expectationFailure ("expected members array, got " <> show other)--        let v1Member = T.unlines ["language keiro-dsl 1", "context report-floor"]-        withInlineWorkspace-          "keiro-dsl-check-report-workspace-floor"-          ( "report-floor",-            [ ("domain/a.keiro", v1Member),-              ("domain/b.keiro", v1Member)-            ]-          )-          $ \root _ _ -> do-            let manifest = root </> "service.keiro-workspace"-                floorReportPath = out </> "workspace-floor.json"-            (floorCode, _, _) <--              runKeiroDsl ["check", manifest, "--min-language", "4", "--report-out", floorReportPath]-            floorCode `shouldBe` ExitFailure 1-            floorReport <- decodeJsonValue floorReportPath-            case jsonField "diagnostics" floorReport of-              Just (Aeson.Array entries) -> case toList entries of-                entry : _ -> do-                  jsonField "file" entry `shouldBe` Just (Aeson.String (T.pack manifest))-                  jsonField "code" entry `shouldBe` Just (Aeson.String "LanguageVersionBelowMinimum")-                  case jsonField "related" entry of-                    Just (Aeson.Array related) -> length related `shouldBe` 2-                    other -> expectationFailure ("expected related-location array, got " <> show other)-                [] -> expectationFailure "workspace-floor report had no diagnostics"-              other -> expectationFailure ("expected diagnostics array, got " <> show other)--        TIO.writeFile unregisteredPath "language keiro-dsl 999999\nthis is intentionally not valid body syntax\n"-        (parseCode, _, _) <--          runKeiroDsl-            [ "check",-              unregisteredPath,-              "--report-out",-              parseFailurePath-            ]-        parseCode `shouldBe` ExitFailure 1-        doesFileExist parseFailurePath `shouldReturn` False--  describe "runtime capability and fold identity baseline (plan 181)" $ do-    it "pins the fold-only FNV-1a-128 UTF-8 encoding" $ do-      foldFingerprint128 "" `shouldBe` "6c62272e07bb014262b821756295c58d"-      foldFingerprint128 "雪" `shouldBe` "a68afaae758b5822836dbc787bb233bd"--    it "pins complete fold surfaces and fingerprints across representative aggregates" $ do-      scalar <- checkedServiceOf "test/fixtures/aggregate-scalar-expressions-v2.keiro"-      nominal <- checkedServiceOf "test/fixtures/nominal-scalars.keiro"-      idDomain <- checkedServiceOf "test/fixtures/id-domain-migration-v3.keiro"-      behavior <- checkedServiceOf "test/fixtures/behavior-complete.keiro"-      workspace <- shouldComposeWorkspace "test/fixtures/workspace-nominals/service.keiro-workspace"-      let actual =-            T.intercalate-              "\n\n"-              [ renderFoldBaseline "aggregate-scalar-expressions-v2" scalar,-                renderFoldBaseline "nominal-scalars" nominal,-                renderFoldBaseline "id-domain-migration-v3" idDomain,-                renderFoldBaseline "behavior-complete" behavior,-                renderFoldBaseline "workspace-nominals" (checkedWorkspace workspace)-              ]-      assertMatchesGolden "test/fixtures/fold-identity-baseline.golden" actual--    it "pins all four runtime gates and fingerprint segment projections" $ do-      nominalSpec <- specOf "test/fixtures/id-domain-migration-v3.keiro"-      nominalRegistry <- case resolveNominalTypes nominalSpec of-        Left errors -> expectationFailure (show errors) >> fail "unreachable"-        Right value -> pure value-      nominal <- case lookupNominalType "OrderId" nominalRegistry of-        Nothing -> expectationFailure "missing OrderId nominal" >> fail "unreachable"-        Just value -> pure value-      strictSpec <--        parseInlineSpec-          "<strict-profile>"-          ( T.unlines-              [ "context strict-profile",-                "aggregate DuplicateRegister",-                "  regs",-                "    value Int = 0",-                "    value Int = 0",-                "  states Open"-              ]-          )-      rows <- forM [1 .. 4 :: Int] $ \number -> do-        contract <- case languageVersion (fromIntegral number) >>= effectiveLanguageContractForVersion of-          Nothing -> expectationFailure ("missing released language contract " <> show number) >> fail "unreachable"-          Just value -> pure value-        let hasAggregateIdDomain = maybe False (const True) (idDomainContractFor contract "ord")-            hasContractIdDomain = maybe False (const True) (contractIdDomainContractFor contract "ord")-            nominalContract = (.contractVersion) <$> nominalEqualityContractForService contract nominal-            strictService = checkedServiceForContract contract strictSpec-            hasStrictValidation = any ((== AggregateDuplicateRegister) . (.code)) (validateService strictService)-        pure-          ( number,-            effectiveRuntimeSemantics contract,-            runtimeSemanticsFingerprintSegments contract,-            hasAggregateIdDomain,-            hasContractIdDomain,-            nominalContract,-            hasStrictValidation-          )-      rows-        `shouldBe` [ (1, "keiro-dsl/runtime-semantics/1", [], False, False, Just "keiro-dsl/nominal-equality/1", False),-                     (2, "keiro-dsl/runtime-semantics/1", [], False, False, Just "keiro-dsl/nominal-equality/1", False),-                     (3, "keiro-dsl/runtime-semantics/2", ["semantic-contract:keiro-dsl/runtime-semantics/2"], True, False, Just "keiro-dsl/nominal-equality/2", False),-                     (4, "keiro-dsl/runtime-semantics/3", ["semantic-contract:keiro-dsl/runtime-semantics/2"], True, True, Just "keiro-dsl/nominal-equality/2", True)-                   ]--    it "explains a serialized runtime-profile mismatch" $ do-      case (Aeson.eitherDecode "{\"languageVersion\":4,\"runtimeSemantics\":\"keiro-dsl/runtime-semantics/2\"}" :: Either String EffectiveLanguageContract) of-        Left message -> do-          message `shouldContain` "runtimeSemantics does not match language version 4"-          message `shouldContain` "keiro-dsl/runtime-semantics/3"-          message `shouldContain` "keiro-dsl/runtime-semantics/2"-        Right _ -> expectationFailure "expected a runtime-profile mismatch"--    it "reports every formerly silent fold-resolution failure and propagates it" $ do-      baseService <- checkedServiceOf "test/fixtures/id-domain-migration-v3.keiro"-      recursiveMapped <- specOf "test/fixtures/mapped-recursive.keiro"-      brokenNominal <- specOf "test/fixtures/nominal-missing-facts.keiro"-      missingInitial <- specOf "test/fixtures/mapped-missing-initial.keiro"-      let contract = checkedLanguageContract baseService-          baseSpec = checkedSpec baseService-          baseAggregate = onlyAggregate baseSpec-          withAggregate transform =-            specWithNodes-              [ NAggregate (transform aggregate)-              | NAggregate aggregate <- baseSpec.nodes-              ]-              baseSpec-          replaceFirstTransition transform aggregate =-            aggregateWithTransitions-              (case aggregate.transitions of transition : rest -> transform transition : rest; [] -> [])-              aggregate-          guardSpec = withAggregate (replaceFirstTransition (transitionWithGuard (Just (EAtom (AName "missingGuardRoot")))))-          outputSpec = withAggregate (replaceFirstTransition (transitionWithEmits ["MissingEvent"]))-          typeGraphSpec = specWithMapped recursiveMapped.mapped baseSpec-          nominalSpec = specWithNominalScalars brokenNominal.nominalScalars baseSpec-          cases =-            [ (checkedServiceForContract contract typeGraphSpec, baseAggregate, \case FoldTypeGraphResolutionFailed {} -> True; _ -> False),-              (checkedServiceForContract contract nominalSpec, baseAggregate, \case FoldNominalResolutionFailed {} -> True; _ -> False),-              (checkedServiceForContract contract missingInitial, onlyAggregate missingInitial, \case FoldRegisterInitialResolutionFailed {} -> True; _ -> False),-              (checkedServiceForContract contract guardSpec, onlyAggregate guardSpec, \case FoldGuardResolutionFailed {} -> True; _ -> False),-              (checkedServiceForContract contract outputSpec, onlyAggregate outputSpec, \case FoldEventOutputResolutionFailed {} -> True; _ -> False)-            ]-      forM_ cases $ \(service, aggregate, matches) -> do-        CheckedFold.aggregateFoldSurfaceForService service aggregate-          `shouldSatisfy` either matches (const False)-        CheckedFold.aggregateFoldFingerprintForService service aggregate-          `shouldSatisfy` either matches (const False)-      let brokenService = checkedServiceForContract contract guardSpec-      CheckedDiff.diffServices brokenService baseService `shouldSatisfy` isLeft-      ReplayImpact.replayImpactServices brokenService baseService `shouldSatisfy` isLeft-      planTestServiceScaffold (defaultContext (guardSpec.context)) brokenService-        `shouldSatisfy` \case-          Left refusals -> any (\case FoldSurfaceRefusal {} -> True; _ -> False) refusals-          Right _ -> False--    it "pins representative diff and replay-impact rendering" $ do-      old <- parsedSourceOf "test/fixtures/reservation.keiro"-      new <- parsedSourceOf "test/fixtures/reservation-guard-tightened.keiro"-      let changes = diffSources old new-          impact = resolvedFold (ReplayImpact.replayImpactServices (checkedSource old) (checkedSource new))-          actual =-            T.intercalate-              "\n"-              ( "diff:"-                  : map renderFinding changes-                    <> ["replay:", ReplayImpact.renderReplayImpact impact]-              )-      assertMatchesGolden "test/fixtures/fold-identity-diff-replay.golden" actual--    it "pins unrelated public 64-bit identities outside the fold digest" $ do-      readModelSpec <- specOf "test/fixtures/readmodel.keiro"-      wireSpec <- specOf "test/fixtures/consumer-types.keiro"-      behaviorSpec <- specOf "test/fixtures/behavior-complete.keiro"-      readModel <- case [value | NReadModel value <- (.nodes) readModelSpec] of-        value : _ -> pure value-        [] -> expectationFailure "missing read-model fixture" >> fail "unreachable"-      graph <- shouldResolveTypeGraph wireSpec-      behaviorKey <- case Behavior.deriveBehaviorRequirements behaviorSpec of-        Right (requirement : _) -> pure (Behavior.unBehaviorKey ((.key) requirement))-        result -> expectationFailure ("missing behavior requirement: " <> show result) >> fail "unreachable"-      deriveShapeHash readModel `shouldBe` "fnv1a:3717f6d9e3c44bd6"-      wireFingerprint graph "ArtifactInfo" `shouldBe` "2bd99b3e57bcde9b"-      behaviorKey `shouldBe` "behavior-v1-0128e858fee6f2b3"--  describe "source language version" $ do-    let legacy = "context hospital-capacity\n"-        declared = "# leading comment\n\nlanguage keiro-dsl 1\ncontext hospital-capacity\n"-        code source = case parseSource "source.keiro" source of-          Left (SourceLanguageFailure diagnostic) -> Just ((.errorCode) diagnostic)-          _ -> Nothing-        parseRight name source = case parseSource name source of-          Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-          Right value -> pure value-        declaredVersionOf DeclaredLanguage {declaredLanguageVersion = version} = Just version-        declaredVersionOf LegacyUnversioned = Nothing-        orderedSubstrings needles haystack = go (map T.pack needles) (T.pack haystack)-          where-            go [] _ = True-            go (needle : rest) remaining =-              let (_, suffix) = T.breakOn needle remaining-               in not (T.null suffix) && go rest (T.drop (T.length needle) suffix)--    it "selects declared v1 after comments while preserving semantic equality" $ do-      legacySource <- parseRight "legacy.keiro" legacy-      declaredSource <- parseRight "declared.keiro" declared-      (.spec) legacySource `shouldBe` (.spec) declaredSource-      (.sourceLanguage) legacySource `shouldBe` LegacyUnversioned-      declaredVersionOf ((.sourceLanguage) declaredSource) `shouldBe` languageVersion 1-      effectiveLanguageVersion ((.sourceLanguage) legacySource)-        `shouldBe` effectiveLanguageVersion ((.sourceLanguage) declaredSource)--    it "threads paired released versions through one checked semantic boundary" $ do-      let body = T.unlines ["context semantic-pair", "aggregate Counter", "  regs", "  states Open"]-          v1Text = "language keiro-dsl 1\n" <> body-          v2Text = "language keiro-dsl 2\n" <> body-      v1Source <- parseRight "reservation-v1.keiro" v1Text-      v2Source <- parseRight "reservation-v2.keiro" v2Text-      let v1Service = checkedSource v1Source-          v2Service = checkedSource v2Source-          v1Spec = checkedSpec v1Service-          v2Spec = checkedSpec v2Service-          ctx = defaultContext (v1Spec.context)-          aggregates spec = [aggregate | NAggregate aggregate <- (.nodes) spec]-      v1Spec `shouldBe` v2Spec-      Just ((.contractLanguageVersion) (checkedLanguageContract v1Service)) `shouldBe` languageVersion 1-      Just ((.contractLanguageVersion) (checkedLanguageContract v2Service)) `shouldBe` languageVersion 2-      effectiveRuntimeSemantics (checkedLanguageContract v1Service)-        `shouldBe` effectiveRuntimeSemantics (checkedLanguageContract v2Service)-      validateService v1Service `shouldBe` validateService v2Service-      scaffoldServiceModules ctx v1Service `shouldBe` scaffoldServiceModules ctx v2Service-      case (aggregates v1Spec, aggregates v2Spec) of-        ([v1Aggregate], [v2Aggregate]) -> do-          aggregateFoldSurfaceForService v1Service v1Aggregate-            `shouldBe` aggregateFoldSurfaceForService v2Service v2Aggregate-          aggregateFoldFingerprintForService v1Service v1Aggregate-            `shouldBe` aggregateFoldFingerprintForService v2Service v2Aggregate-        other -> expectationFailure ("expected one aggregate per paired source, got " <> show (fmap length other))-      diffServices v1Service v2Service `shouldBe` []-      resolvedFold (ReplayImpact.replayImpactServices v1Service v2Service) `shouldBe` ReplayNeutral--    it "retains one effective contract for same-version workspaces and refuses mixed versions" $ do-      let manifest = "service semantic-workspace\nspec domain/a.keiro\nspec domain/b.keiro\n"-          v1Body = "language keiro-dsl 1\ncontext semantic-workspace\n"-          v2Body = "language keiro-dsl 2\ncontext semantic-workspace\n"-          sourceWith b =-            memoryContentSource-              ( Map.fromList-                  [ ("service.keiro-workspace", manifest),-                    ("domain/a.keiro", b),-                    ("domain/b.keiro", b)-                  ]-              )-          mixedSource =-            memoryContentSource-              ( Map.fromList-                  [ ("service.keiro-workspace", manifest),-                    ("domain/a.keiro", v1Body),-                    ("domain/b.keiro", v2Body)-                  ]-              )-      sameVersion <- loadWorkspace (sourceWith v2Body) "service.keiro-workspace"-      case sameVersion of-        Right workspace -> do-          Just ((.contractLanguageVersion) (checkedLanguageContract (checkedWorkspace workspace))) `shouldBe` languageVersion 2-          validateService (checkedWorkspace workspace) `shouldBe` []-        Left failure -> expectationFailure (show failure)-      mixed <- loadWorkspace mixedSource "service.keiro-workspace"-      case mixed of-        Left (WorkspaceRefused diagnostics) ->-          map (.code) (NE.toList diagnostics) `shouldContain` [WorkspaceLanguageVersionMismatch]-        other -> expectationFailure ("expected a mixed-version refusal, got " <> show other)--    it "refuses a source/service contract mismatch before creating the output directory" $ do-      v1Version <- maybe (expectationFailure "version 1 missing" >> fail "unreachable") pure (languageVersion 1)-      parsed <- parseRight "semantic-v2.keiro" "language keiro-dsl 2\ncontext semantic-refusal\n"-      let service = checkedSource parsed-          ctx = defaultContext "semantic-refusal"-      modules <- case planTestServiceScaffold ctx service of-        Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-        Right planned -> pure planned-      withTempDirectory "keiro-dsl-semantic-refusal" $ \root -> do-        let out = root </> "not-created"-        result <- executeServiceScaffold out False "semantic-v2.keiro" (DeclaredLanguage v1Version noLoc) ctx service modules-        result `shouldBe` Left [SemanticContractMismatch "source provenance and checked service selected different effective language contracts"]-        doesDirectoryExist out `shouldReturn` False--    it "retains explicit declarations in source rendering and leaves legacy unversioned" $ do-      legacySource <- parseRight "legacy.keiro" legacy-      declaredSource <- parseRight "declared.keiro" declared-      renderSource legacySource `shouldBe` "context hospital-capacity\n"-      renderSource declaredSource `shouldBe` "language keiro-dsl 1\ncontext hospital-capacity\n"-      parseSpec "declared.keiro" declared `shouldBe` Right ((.spec) declaredSource)--    it "classifies invalid, unsupported, duplicate, and misplaced preambles" $ do-      code "language keiro-dsl 0\ncontext hospital-capacity\n" `shouldBe` Just InvalidLanguageVersion-      code "language keiro-dsl nope\ncontext hospital-capacity\n" `shouldBe` Just InvalidLanguageVersion-      code "language keiro-dsl -1\ncontext hospital-capacity\n" `shouldBe` Just InvalidLanguageVersion-      code "language keiro-dsl 999999\ncontext hospital-capacity\n" `shouldBe` Just UnsupportedLanguageVersion-      code "language keiro-dsl 1\nlanguage keiro-dsl 1\ncontext hospital-capacity\n" `shouldBe` Just DuplicateLanguagePreamble-      code "context hospital-capacity\nlanguage keiro-dsl 1\n" `shouldBe` Just MisplacedLanguagePreamble--    it "treats language and successor spellings as data in nested grammar positions" $ do-      forM_ ["language-identifier-v1.keiro", "language-identifier-v2.keiro"] $ \fixture -> do-        source <- readTestText ("test/fixtures/" <> fixture)-        parsed <- parseRight fixture source-        validateSpec ((.spec) parsed) `shouldBe` []-      v1 <- readTestText "test/fixtures/language-identifier-v1.keiro"-      let manifest = "service language-collisions\nspec domain/collisions.keiro\n"-          workspaceSource = memoryContentSource (Map.fromList [("service.keiro-workspace", manifest), ("domain/collisions.keiro", v1)])-      loaded <- loadWorkspace workspaceSource "service.keiro-workspace"-      loaded `shouldSatisfy` isRight--    it "keeps duplicate and misplaced preamble diagnostics on their grammar lines" $ do-      let sourceFailureAt expectedCode expectedLine source =-            case parseSource "located.keiro" source of-              Left (SourceLanguageFailure diagnostic) -> do-                (.errorCode) diagnostic `shouldBe` expectedCode-                unLoc ((.loc) diagnostic) `shouldBe` expectedLine-              other -> expectationFailure ("expected located source-language failure, got " <> show other)-      sourceFailureAt DuplicateLanguagePreamble 2 "language keiro-dsl 1\nlanguage keiro-dsl 1\ncontext located\n"-      sourceFailureAt MisplacedLanguagePreamble 3 "context located\nid language prefix=lang\nlanguage keiro-dsl 1\n"--    it "rejects a future version before parsing an invalid v1 body" $-      case parseSource "unregistered.keiro" "language keiro-dsl 999999\nthis is not a v2 body\n" of-        Left failure@(SourceLanguageFailure diagnostic) -> do-          (.errorCode) diagnostic `shouldBe` UnsupportedLanguageVersion-          renderParseFailure failure `shouldSatisfy` T.isInfixOf "supported versions: 1, 2, 3, 4, 5"-          renderParseFailure failure `shouldNotSatisfy` T.isInfixOf "expecting `context`"-        other -> expectationFailure ("expected source-language failure, got " <> show other)--    it "accepts and canonically round-trips nominal declarations only in v2" $ do-      let nominalSource =-            T.unlines-              [ "language keiro-dsl 2",-                "context orders",-                "id OrderId prefix=ord using {",-                "  haskell package=orders-domain module=Orders.Id type=OrderId",-                "  binding = \"Orders.KeiroBindings.orderIdBinding\"",-                "  binding-version = \"1\"",-                "  canonical-type = \"orders.OrderId.v1\"",-                "  fixtures = \"Orders.KeiroBindings.orderIdFixtures\"",-                "}",-                "enum OrderStatus { Draft=draft Submitted=submitted } using {",-                "  haskell package=orders-domain module=Orders.Order type=OrderStatus",-                "  binding = \"Orders.KeiroBindings.orderStatusBinding\"",-                "  binding-version = \"1\"",-                "  canonical-type = \"orders.OrderStatus.v1\"",-                "  fixtures = \"Orders.KeiroBindings.orderStatusFixtures\"",-                "}",-                "mapped nominal AccountNumber : Text {",-                "  haskell package=orders-domain module=Orders.Account type=AccountNumber",-                "  binding = \"Orders.KeiroBindings.accountNumberBinding\"",-                "  binding-version = \"1\"",-                "  canonical-type = \"orders.AccountNumber.v1\"",-                "  fixtures = \"Orders.KeiroBindings.accountNumberFixtures\"",-                "  initial = \"Orders.KeiroBindings.initialAccountNumber\"",-                "}"-              ]-      parsed <- parseRight "nominal.keiro" nominalSource-      length ((.ids) ((.spec) parsed)) `shouldBe` 1-      length ((.enums) ((.spec) parsed)) `shouldBe` 1-      length ((.nominalScalars) ((.spec) parsed)) `shouldBe` 1-      parseSource "nominal-round-trip.keiro" (renderSource parsed) `shouldBe` Right parsed--    it "reports successor nominal syntax as one language-version diagnostic under v1 and legacy" $ do-      let body = "context orders\nmapped nominal AccountNumber : Text {}\n"-      code ("language keiro-dsl 1\n" <> body) `shouldBe` Just LanguageFeatureRequiresVersion-      code body `shouldBe` Just LanguageFeatureRequiresVersion--    it "parses and canonically round-trips field aliases only in language 4" $ do-      let v4Source =-            T.unlines-              [ "language keiro-dsl 4",-                "context aliases",-                "aggregate Order",-                "  regs",-                "  states Open",-                "  command Change { type haskell payloadType as \"type\":Text haskell as }",-                "contract publicOrder {",-                "  schemaVersion 1",-                "  discriminator kind",-                "  topic changes \"orders.v1\"",-                "  event Changed on changes {",-                "    region haskell serviceRegion as \"region_code\": text",-                "  }",-                "}"-              ]-          v3Source = T.replace "language keiro-dsl 4" "language keiro-dsl 3" v4Source-      parsed <- parseRight "field-aliases.keiro" v4Source-      parseSource "field-aliases-round-trip.keiro" (renderSource parsed) `shouldBe` Right parsed-      case (.nodes) ((.spec) parsed) of-        [NAggregate aggregate, NContract contract] -> do-          case (.fields) =<< (.commands) aggregate of-            aliased : haskellField : asField : _ -> do-              ((.name) aliased, (.selector) aliased, (.wireKey) aliased)-                `shouldBe` ("type", Just "payloadType", Just "type")-              map (.name) [haskellField, asField] `shouldBe` ["haskell", "as"]-            fields -> expectationFailure ("unexpected aggregate alias fields: " <> show fields)-          case (.fields) =<< (.events) contract of-            [field] ->-              ((.name) field, (.selector) field, (.wireKey) field, (.loc) field)-                `shouldBe` ("region", Just "serviceRegion", Just "region_code", Loc 12)-            fields -> expectationFailure ("unexpected contract alias fields: " <> show fields)-        nodes -> expectationFailure ("unexpected alias nodes: " <> show nodes)-      code v3Source `shouldBe` Just LanguageFeatureRequiresVersion--    it "attributes every successor feature gate to its owning grammar production" $ do-      let featureFailureAt expectedLine source =-            case parseSource "feature.keiro" source of-              Left (SourceLanguageFailure diagnostic) -> do-                (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion-                unLoc ((.loc) diagnostic) `shouldBe` expectedLine-              other -> expectationFailure ("expected a located feature gate, got " <> show other)-          aggregateWith clause =-            T.unlines-              [ "language keiro-dsl 1",-                "context feature-gates",-                "aggregate Account",-                "  regs",-                "    balance Text = \"0\"",-                "  states Open",-                "  command Adjust { amount:Text }",-                "  event Adjusted = fields(Adjust)",-                "  Open -- Adjust --> " <> clause <> " ; emit Adjusted ; goto Open"-              ]-      featureFailureAt 3 (T.unlines ["language keiro-dsl 1", "context feature-gates", "id AccountId prefix=acct using {"])-      featureFailureAt 3 (T.unlines ["language keiro-dsl 1", "context feature-gates", "mapped nominal AccountNumber : Text {}"])-      featureFailureAt 5 (T.unlines ["language keiro-dsl 1", "context feature-gates", "aggregate Account", "  regs", "    balance Integer = 0", "  states Open"])-      featureFailureAt 9 (aggregateWith "guard reg.balance == cmd.amount")-      featureFailureAt 9 (aggregateWith "implementation hole")--    it "reports a declaration-only rewrite without semantic, generated, fold, or replay impact" $ do-      fixture <- readTestText "test/fixtures/language-v1.keiro"-      let legacyFixture = T.unlines (drop 1 (T.lines fixture))-      legacySource <- parseRight "legacy.keiro" legacyFixture-      declaredSource <- parseRight "declared.keiro" fixture-      let oldSpec = (.spec) legacySource-          newSpec = (.spec) declaredSource-          changes = diffSources legacySource declaredSource-          vectors = [kind.vector | change <- changes, let kind = workspaceChangeKind change]-      map changeCode changes `shouldBe` [SourceLanguageDeclarationChanged]-      legacyDiffSpecs oldSpec newSpec `shouldBe` []-      vectors `shouldSatisfy` all (\compatibility -> all ((== VCompatible) . (`verdictFor` compatibility)) [minBound .. maxBound])-      case changes of-        [change] ->-          remediationFor ((workspaceChangeKind change).context) SourceLanguageDeclarationChanged-            `shouldBe` (RemedyNoSemanticAction :| [])-        _ -> expectationFailure "expected one source-language change"-      let legacyGeneratedSurface spec =-            [ ((.path) scaffoldModule, (.text) scaffoldModule, (.kind) scaffoldModule)-            | scaffoldModule <- scaffoldModules (defaultContext (spec.context)) spec-            ]-          legacyFoldFingerprint spec aggregate = aggregateFoldFingerprintForService (legacyCheckedService spec) aggregate-      legacyGeneratedSurface oldSpec `shouldBe` legacyGeneratedSurface newSpec-      [legacyFoldFingerprint oldSpec aggregate | NAggregate aggregate <- (.nodes) oldSpec]-        `shouldBe` [legacyFoldFingerprint newSpec aggregate | NAggregate aggregate <- (.nodes) newSpec]-      legacyReplayImpactSpecs oldSpec newSpec `shouldBe` ReplayNeutral--    it "exposes published support in source and workspace JSON inspection" $ do-      (sourceCode, sourceOut, sourceErr) <- runKeiroDsl ["inspect", "test/fixtures/reservation.keiro", "--format=json"]-      sourceCode `shouldBe` ExitSuccess-      sourceErr `shouldBe` ""-      sourceOut `shouldContain` "\"schema\":\"keiro-dsl/source-inspection/1\""-      sourceOut `shouldContain` "\"kind\":\"source\""-      sourceOut `shouldContain` "\"sourceForm\":\"declared\""-      sourceOut `shouldContain` "\"declaredLanguageVersion\":4"-      sourceOut `shouldContain` "\"effectiveLanguageVersion\":4"-      sourceOut `shouldContain` "\"effectiveSemanticContract\":{"-      sourceOut `shouldContain` "\"runtimeSemantics\":\"keiro-dsl/runtime-semantics/3\""-      sourceOut `shouldContain` "\"languageSupport\":\"compatibility-only\""-      (workspaceCode, workspaceOut, workspaceErr) <- runKeiroDsl ["inspect", canonicalWorkspacePath, "--format=json"]-      workspaceCode `shouldBe` ExitSuccess-      workspaceErr `shouldBe` ""-      workspaceOut `shouldContain` "\"kind\":\"workspace\""-      workspaceOut `shouldContain` "\"service\":\"demo-project\""-      workspaceOut `shouldContain` "\"effectiveSemanticContract\":{"-      workspaceOut `shouldContain` "\"languageSupport\":\"compatibility-only\""-      workspaceOut `shouldSatisfy` orderedSubstrings ["domain/project-artifact.keiro", "domain/project.keiro", "domain/shared.keiro"]-      (stableCode, stableOut, stableErr) <- runKeiroDsl ["inspect", "test/fixtures/workflow-evolution.keiro", "--format=json"]-      stableCode `shouldBe` ExitSuccess-      stableErr `shouldBe` ""-      stableOut `shouldContain` "\"declaredLanguageVersion\":5"-      stableOut `shouldContain` "\"effectiveLanguageVersion\":5"-      stableOut `shouldContain` "\"languageSupport\":\"stable\""--    it "keeps only the named source-version fixtures outside published Language 4" $ do-      fixtureTree <- treeSnapshot "test/fixtures"-      let outsideStableV4 =-            sort-              [ path-              | (path, contents) <- fixtureTree,-                takeExtension path == ".keiro",-                "language keiro-dsl 4" `notElem` T.lines contents-              ]-      outsideStableV4-        `shouldBe` sort-          [ "aggregate-collection-expressions-v2-rejects.keiro",-            "aggregate-scalar-expressions-v1-rejects.keiro",-            "catalog-readmodel-backing-required.keiro",-            "catalog-readmodel-backing-unobserved.keiro",-            "catalog-readmodel-physical-override.keiro",-            "catalog-readmodel-reorder-a.keiro",-            "catalog-readmodel-reorder-b.keiro",-            "contract-v1-compat.keiro",-            "declarative-router/unbounded.keiro",-            "declarative-router/valid.keiro",-            "domain-command-outcomes.keiro",-            "id-domain-migration-v3.keiro",-            "language-duplicate.keiro",-            "language-identifier-v1.keiro",-            "language-identifier-v2.keiro",-            "language-legacy.keiro",-            "language-malformed.keiro",-            "language-misplaced.keiro",-            "language-v1.keiro",-            "language-zero.keiro",-            "mapped-readmodel-workspace/readmodel.keiro",-            "mapped-readmodel-workspace/types.keiro",-            "mapped-readmodel.keiro",-            "mapped-workqueue.keiro",-            "nominal-v1.keiro",-            "outcome-identifier-legacy.keiro",-            "outcome-identifier-v5.keiro",-            "projection-catalog-unrelated.keiro",-            "projection-catalog.keiro",-            "projection-owner-multi-query.keiro",-            "workflow-evolution.keiro"-          ]--    it "checks v1 and inspects legacy explicitly" $ do-      (v1Code, v1Out, v1Err) <- runKeiroDsl ["check", "test/fixtures/language-v1.keiro"]-      v1Code `shouldBe` ExitSuccess-      v1Out `shouldBe` "OK\n"-      v1Err `shouldContain` "language contract: effective keiro-dsl 1 (declared, compatibility-only, runtime semantics keiro-dsl/runtime-semantics/1)"-      (legacyCode, legacyOut, legacyErr) <- runKeiroDsl ["inspect", "test/fixtures/language-legacy.keiro", "--format=json"]-      legacyCode `shouldBe` ExitSuccess-      legacyErr `shouldBe` ""-      legacyOut `shouldContain` "\"sourceForm\":\"legacy-unversioned\""-      legacyOut `shouldContain` "\"declaredLanguageVersion\":null"-      legacyOut `shouldContain` "\"effectiveLanguageVersion\":1"-      legacyOut `shouldContain` "\"languageSupport\":\"compatibility-only\""--    it "checks and scaffolds contextual language identifiers through the CLI" $ do-      forM_ ["language-identifier-v1.keiro", "language-identifier-v2.keiro"] $ \fixture -> do-        let sourcePath = "test/fixtures/" <> fixture-        (checkCode, checkOut, checkErr) <- runKeiroDsl ["check", sourcePath]-        checkCode `shouldBe` ExitSuccess-        checkOut `shouldBe` "OK\n"-        checkErr `shouldContain` "language contract: effective keiro-dsl"-        withTempDirectory ("keiro-dsl-" <> fixture) $ \out -> do-          (scaffoldCode, _, scaffoldErr) <- runKeiroDsl ["scaffold", sourcePath, "--out", out]-          scaffoldCode `shouldBe` ExitSuccess-          scaffoldErr `shouldContain` "language contract: effective keiro-dsl"-          scaffoldErr `shouldContain` "firewall: OK"--    it "notices only the working-tree contract during diff" $-      withTempDirectory "keiro-dsl-language-diff" $ \repository -> do-        source <- readTestText "test/fixtures/language-v1.keiro"-        TIO.writeFile (repository </> "language.keiro") source-        let git arguments = readProcessWithExitCode "git" ("-C" : repository : arguments) ""-        forM_-          [ ["init", "--quiet"],-            ["add", "language.keiro"],-            ["-c", "user.name=keiro-dsl-test", "-c", "user.email=keiro-dsl-test@example.invalid", "commit", "--quiet", "-m", "test: capture language contract baseline"]-          ]-          $ \arguments -> do-            (gitCode, gitOut, gitErr) <- git arguments-            unless (gitCode == ExitSuccess) (expectationFailure (gitOut <> gitErr))-        (diffCode, _, diffErr) <- withCurrentDirectory repository (runKeiroDsl ["diff", "language.keiro", "--since", "HEAD"])-        diffCode `shouldBe` ExitSuccess-        T.count "language contract:" (T.pack diffErr) `shouldBe` 1-        diffErr `shouldContain` "language contract: effective keiro-dsl 1 (declared, compatibility-only, runtime semantics keiro-dsl/runtime-semantics/1)"--    it "preserves a workspace member's source-selection code beneath outer attribution" $ do-      let manifest = "service demo\nspec domain/future.keiro\n"-          futureSource = "language keiro-dsl 999999\nthis body must not parse\n"-          source = memoryContentSource (Map.fromList [("service.keiro-workspace", manifest), ("domain/future.keiro", futureSource)])-      loaded <- loadWorkspace source "service.keiro-workspace"-      case loaded of-        Left (WorkspaceRefused (diagnostic :| [])) -> do-          diagnostic.code `shouldBe` WorkspaceMemberParseFailed-          (.errorCode) <$> (.sourceLanguageCause) diagnostic-            `shouldBe` Just UnsupportedLanguageVersion-          renderWorkspaceDiagnostic "service.keiro-workspace" diagnostic-            `shouldSatisfy` T.isInfixOf "UnsupportedLanguageVersion"-        other -> expectationFailure ("expected one attributed source-language refusal, got " <> show other)--    it "attributes a workspace provenance-only diff to the changed member" $ do-      workspace <- shouldComposeWorkspace canonicalWorkspacePath-      case (.members) workspace of-        firstMember : remaining -> do-          let changedMember =-                WorkspaceMember-                  { path = firstMember.path,-                    spec = firstMember.spec,-                    sourceLanguage = LegacyUnversioned,-                    sourceIndex = firstMember.sourceIndex,-                    lineBase = firstMember.lineBase,-                    lineCount = firstMember.lineCount-                  }-              changedWorkspace = workspaceWithMembers (changedMember : remaining) workspace-              changes = diffWorkspaces workspace changedWorkspace-          map (changeCode . (.change)) changes `shouldBe` [SourceLanguageDeclarationChanged]-          map (fmap (.file) . (.declarationSite)) changes `shouldBe` [Just ((.path) firstMember)]-          map (.change) changes `shouldSatisfy` all (not . gatedBreaking (gateWith [minBound .. maxBound]))-        _ -> expectationFailure "canonical workspace had no member"--  describe "typed-domain-outcomes" $ do-    it "parses, validates, and canonically round-trips the complete language-5 fixture" $ do-      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"-      parsed <- case parseSource "domain-command-outcomes.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      validateService (checkedSource parsed) `shouldBe` []-      parseSource "domain-command-outcomes-rendered.keiro" (renderSource parsed) `shouldBe` Right parsed-      let outcomeKind :: TransitionOutcome -> T.Text-          outcomeKind outcome = case outcome of-            OutcomeAccepted {} -> "accepted"-            OutcomeRejected {} -> "rejected"-            OutcomeNoOp {} -> "no-op"-      case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) parsed)] of-        [aggregate] -> do-          fmap (\types -> ((.rejectionType) types, (.noOpType) types)) ((.domainOutcomeTypes) aggregate)-            `shouldBe` Just ("ReservationRejection", "ReservationNoOp")-          map (fmap outcomeKind . (.outcome)) ((.transitions) aggregate)-            `shouldBe` map Just ["accepted", "rejected", "no-op"]-        aggregates -> expectationFailure ("unexpected outcome aggregates: " <> show aggregates)--    it "gates the syntax to Language 5" $ do-      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"-      case parseSource "domain-command-outcomes-v4.keiro" (T.replace "language keiro-dsl 5" "language keiro-dsl 4" source) of-        Left (SourceLanguageFailure diagnostic) -> (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion-        other -> expectationFailure ("expected language feature refusal, got " <> show other)--    it "generates one direct exact-edge classifier arm per silent outcome" $ do-      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"-      parsed <- case parseSource "domain-command-outcomes.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      aggregate <- case [value | NAggregate value <- (.nodes) ((.spec) parsed)] of-        [value] -> pure value-        values -> expectationFailure ("unexpected outcome aggregates: " <> show values) >> fail "unreachable"-      let scaffoldContext = defaultContext (parsed.spec.context)-          modules = scaffoldAggregateForService scaffoldContext (checkedSource parsed) aggregate-          modulesAgain = scaffoldAggregateForService scaffoldContext (checkedSource parsed) aggregate-          eventStream = case [(.text) value | value <- modules, "/EventStream.hs" `T.isSuffixOf` T.pack ((.path) value)] of-            [value] -> value-            values -> error ("unexpected outcome event-stream modules: " <> show values)-          behaviorContract = case [(.text) value | value <- modules, "/BehaviorContract.hs" `T.isSuffixOf` T.pack ((.path) value)] of-            [value] -> value-            values -> error ("unexpected outcome behavior-contract modules: " <> show values)-      map (.text) modulesAgain `shouldBe` map (.text) modules-      firewallBreaches modules `shouldBe` []-      eventStream `shouldSatisfy` T.isInfixOf "reservationDomainCommandHandler"-      eventStream `shouldSatisfy` T.isInfixOf "case edgeSource of"-      eventStream `shouldSatisfy` T.isInfixOf "case edgeIndex of"-      T.count " -> SilentRejected" eventStream `shouldBe` 1-      T.count " -> SilentNoOp" eventStream `shouldBe` 1-      T.count "K.evalTerm" eventStream `shouldBe` 2-      eventStream `shouldSatisfy` T.isInfixOf "0 -> SilentRejected"-      eventStream `shouldSatisfy` T.isInfixOf "1 -> SilentNoOp"-      forM_ ["Data.Map", "lookup", "find", "edgesOut", "Keiro.Command.Domain"] $ \forbidden ->-        eventStream `shouldSatisfy` (not . T.isInfixOf forbidden)-      behaviorContract `shouldSatisfy` T.isInfixOf "RejectedWith ReservationRejection"-      behaviorContract `shouldSatisfy` T.isInfixOf "NoOpWith ReservationNoOp"-      behaviorContract `shouldSatisfy` T.isInfixOf "runSilentDecision"-      behaviorContract `shouldSatisfy` T.isInfixOf "reservationDomainCommandHandler"--    it "reports complete, typed, and state-preserving outcome diagnostics" $ do-      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"-      let codes changed = do-            case parseSource "domain-outcome-mutation.keiro" changed of-              Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> pure []-              Right parsed -> pure (map (.code) (validateService (checkedSource parsed)))-          expectCode expected changed = codes changed >>= (`shouldContain` [expected])-      expectCode-        DomainOutcomeDeclarationDuplicate-        (T.replace "  domain-outcomes rejection=ReservationRejection no-op=ReservationNoOp\n" "  domain-outcomes rejection=ReservationRejection no-op=ReservationNoOp\n  domain-outcomes rejection=ReservationRejection no-op=ReservationNoOp\n" source)-      expectCode-        DomainOutcomeDeclarationMissing-        (T.replace "  domain-outcomes rejection=ReservationRejection no-op=ReservationNoOp\n" "" source)-      expectCode-        DomainOutcomeClauseMissing-        (T.replace "    outcome accepted\n" "" source)-      expectCode-        DomainOutcomeClauseDuplicate-        (T.replace "    outcome accepted\n" "    outcome accepted\n    outcome accepted\n" source)-      expectCode-        DomainOutcomeTypeUnresolved-        (T.replace "rejection=ReservationRejection" "rejection=MissingRejection" source)-      expectCode-        DomainOutcomeReasonTypeMismatch-        (T.replace "ReservationRejection.AlreadyCancelled" "ReservationNoOp.DuplicateRequest" source)-      expectCode-        DomainOutcomeAcceptedWithoutEvents-        (T.replace "    emit Cancelled\n" "" source)-      expectCode-        DomainOutcomeSilentEmits-        (T.replace "    outcome rejected ReservationRejection.AlreadyCancelled\n" "    outcome rejected ReservationRejection.AlreadyCancelled\n    emit Cancelled\n" source)-      expectCode-        DomainOutcomeSilentWrites-        (T.replace "    outcome no-op ReservationNoOp.DuplicateRequest\n" "    outcome no-op ReservationNoOp.DuplicateRequest\n    write lastRequestId := cmd.requestId\n" source)-      expectCode-        DomainOutcomeSilentStateChange-        (T.replace "    outcome no-op ReservationNoOp.DuplicateRequest\n    goto CancelledState\n" "    outcome no-op ReservationNoOp.DuplicateRequest\n    goto Eligible\n" source)-      expectCode-        DomainOutcomeReplayOnlyClause-        (T.replace "  CancelledState -- Cancel -->\n    guard cmd.requestId != reg.lastRequestId" "  replay-only CancelledState -- Cancel -->\n    guard cmd.requestId != reg.lastRequestId" source)--    it "changes behavior identity and semantic diff without moving fold or replay identity" $ do-      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"-      let changedSource = T.replace "ReservationRejection.AlreadyCancelled" "ReservationRejection.CapacityUnavailable" source-      oldParsed <- case parseSource "domain-outcomes-old.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      newParsed <- case parseSource "domain-outcomes-new.keiro" changedSource of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      validateService (checkedSource newParsed) `shouldBe` []-      oldAggregate <- case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) oldParsed)] of-        [aggregate] -> pure aggregate-        aggregates -> expectationFailure ("unexpected old outcome aggregates: " <> show aggregates) >> fail "unreachable"-      newAggregate <- case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) newParsed)] of-        [aggregate] -> pure aggregate-        aggregates -> expectationFailure ("unexpected new outcome aggregates: " <> show aggregates) >> fail "unreachable"-      let changes = diffSources oldParsed newParsed-          oldBehavior = Behavior.deriveAggregateBehaviorRequirements ((.spec) oldParsed) oldAggregate-          newBehavior = Behavior.deriveAggregateBehaviorRequirements ((.spec) newParsed) newAggregate-          changeKind change = case change of-            Additive value -> value-            Advisory value -> value-            Breaking value -> value-      map ((.code) . changeKind) changes `shouldContain` [DomainTransitionOutcomeChanged]-      map ((.code) . changeKind) changes `shouldNotContain` [AggFoldSurfaceChanged]-      aggregateFoldFingerprintForService (checkedSource oldParsed) oldAggregate-        `shouldBe` aggregateFoldFingerprintForService (checkedSource newParsed) newAggregate-      oldBehavior `shouldNotBe` newBehavior-      ReplayImpact.replayImpactServices (checkedSource oldParsed) (checkedSource newParsed)-        `shouldBe` Right ReplayImpact.ReplayNeutral--  describe "outcome identifier compatibility" $ do-    it "parses outcome as an ordinary identifier under legacy and declared language 1" $ do-      source <- readTestText "test/fixtures/outcome-identifier-legacy.keiro"-      case parseSource "outcome-identifier-legacy.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-        Right _ -> pure ()-      case parseSource "outcome-identifier-v1.keiro" ("language keiro-dsl 1\n" <> source) of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-        Right _ -> pure ()--    it "parses outcome as an ordinary identifier under languages 2, 3, and 4" $ do-      source <- readTestText "test/fixtures/outcome-identifier.keiro"-      forM_ ["2", "3", "4"] $ \version ->-        case parseSource-          ("outcome-identifier-v" <> T.unpack version <> ".keiro")-          (T.replace "language keiro-dsl 4" ("language keiro-dsl " <> version) source) of-          Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-          Right parsed-            | version == "4" -> validateService (checkedSource parsed) `shouldBe` []-            | otherwise -> pure ()--    it "parses outcome as an enum constructor, state, and transition source" $ do-      source <- readTestText "test/fixtures/outcome-identifier-positions.keiro"-      case parseSource "outcome-identifier-positions.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-        Right parsed -> validateService (checkedSource parsed) `shouldBe` []--    it "round-trips outcome identifiers through the canonical renderer" $ do-      source <- readTestText "test/fixtures/outcome-identifier.keiro"-      parsed <- case parseSource "outcome-identifier.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      parseSource "outcome-identifier-rendered.keiro" (renderSource parsed) `shouldBe` Right parsed--    it "keeps outcome usable as an identifier alongside language-5 outcome clauses" $ do-      source <- readTestText "test/fixtures/outcome-identifier-v5.keiro"-      case parseSource "outcome-identifier-v5.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-        Right parsed -> validateService (checkedSource parsed) `shouldBe` []--  describe "language-5 projection catalogs" $ do-    it "rejects explicit physical coordinates on a catalog-bound read model" $ do-      errorCodesOf "test/fixtures/catalog-readmodel-physical-override.keiro"-        `shouldReturn` [CatalogReadModelPhysicalOverride]--    it "requires an observed backing target for multi-target read models" $ do-      errorCodesOf "test/fixtures/catalog-readmodel-backing-required.keiro"-        `shouldReturn` [CatalogReadModelBackingRequired]-      errorCodesOf "test/fixtures/catalog-readmodel-backing-unobserved.keiro"-        `shouldReturn` [CatalogReadModelBackingUnobserved]--    it "binds catalog read models by name and ignores observed-target order" $ do-      sourceA <- readTestText "test/fixtures/catalog-readmodel-reorder-a.keiro"-      sourceB <- readTestText "test/fixtures/catalog-readmodel-reorder-b.keiro"-      parsedA <- case parseSource "catalog-readmodel-reorder-a.keiro" sourceA of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      case parseSource "catalog-readmodel-reorder-a-rendered.keiro" (renderSource parsedA) of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-        Right rendered -> (.spec) rendered `shouldBe` (.spec) parsedA-      serviceA <- checkedServiceFromText "catalog-readmodel-reorder-a.keiro" sourceA-      serviceB <- checkedServiceFromText "catalog-readmodel-reorder-b.keiro" sourceB-      validateService serviceA `shouldBe` []-      validateService serviceB `shouldBe` []-      let ctx = defaultContext ((checkedSpec serviceA).context)-          modulesA = scaffoldServiceModules ctx serviceA-          modulesB = scaffoldServiceModules ctx serviceB-          generatedBytes modules = sort [((.path) moduleValue, (.text) moduleValue) | moduleValue <- modules]-          tableA = generatedTextEndingIn "Generated/BindingDemo/LedgerView/ReadModelTable.hs" modulesA-      generatedBytes modulesA `shouldBe` generatedBytes modulesB-      tableA `shouldSatisfy` T.isInfixOf "qualifyTable \"billing\" \"ledger_entries\""-      map ((.code) . kindOfChange) (diffServices serviceA serviceB)-        `shouldNotContain` [CatalogQueryBindingChanged]--    it "emits grouped harness facts against the generated projection catalog" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      service <- checkedServiceFromText "projection-catalog.keiro" source-      let spec = checkedSpec service-          modules = scaffoldServiceModules (defaultContext (spec.context)) service-          auditHarness = generatedTextEndingIn "Generated/CatalogDemo/CatalogAudit/ReadModelHarness.hs" modules-          totalsHarness = generatedTextEndingIn "Generated/CatalogDemo/OrderTotalsLookup/ReadModelHarness.hs" modules-          shipmentHarness = generatedTextEndingIn "Generated/CatalogDemo/ShipmentLookup/ReadModelHarness.hs" modules-      auditHarness `shouldSatisfy` T.isInfixOf "import Generated.CatalogDemo.ProjectionCatalog qualified as ProjectionCatalog"-      auditHarness `shouldSatisfy` T.isInfixOf "ProjectionCatalog.projectionCatalogAsyncRegistrations"-      auditHarness `shouldSatisfy` T.isInfixOf "ProjectionCatalog.projectionCatalogQuerySupplies"-      auditHarness `shouldSatisfy` T.isInfixOf "catalog-demo-catalogAudit|1|fnv1a:9682af3ada04bf50|reporting"-      auditHarness `shouldSatisfy` T.isInfixOf "asyncRegistration:audit_writer"-      auditHarness `shouldSatisfy` T.isInfixOf "querySupply"-      auditHarness `shouldSatisfy` T.isInfixOf "projectionDelivery"-      auditHarness `shouldSatisfy` T.isInfixOf "(\"freshness\", \"Immediate\""-      auditHarness `shouldSatisfy` T.isInfixOf "(\"cursorAuthority\", \"DurableQueryCursor \\\"catalog-demo-audit\\\"\""-      auditHarness `shouldSatisfy` T.isInfixOf "catalog-demo-audit|catalog-demo-audit-v1"-      auditHarness `shouldNotSatisfy` T.isInfixOf "\"catalog-managed\", \"catalog-managed\""-      totalsHarness `shouldSatisfy` T.isInfixOf "order_summary_writer|reporting|order_totals"-      shipmentHarness `shouldSatisfy` T.isInfixOf "catalogRegistration"-      shipmentHarness `shouldNotSatisfy` T.isInfixOf "asyncRegistration:"--    it "parses, validates, and canonically round-trips the closed-world catalog graph" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      parsed <- case parseSource "projection-catalog.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      validateService (checkedSource parsed) `shouldBe` []-      case parseSource "projection-catalog-rendered.keiro" (renderSource parsed) of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-        Right rendered -> (.spec) rendered `shouldBe` (.spec) parsed--      let spec = parsed.spec-          targets = [target | NProjectionTarget target <- (.nodes) spec]-          groups = [groupNode | NRebuildGroup groupNode <- (.nodes) spec]-          externalReads = [externalRead | NExternalRead externalRead <- (.nodes) spec]-          owners = [owner | NProjectionOwner owner <- (.nodes) spec]-      map (.name) targets `shouldBe` ["order_summary", "audit_log", "order_totals", "shipment_summary"]-      map (.name) groups `shouldBe` ["reporting", "shipping"]-      map (\externalRead -> ((.name) externalRead, (.version) externalRead, (.queryModel) externalRead)) externalReads-        `shouldBe` [("order_totals_reader", 1, "order_totals_lookup")]-      map (.name) owners `shouldBe` ["order_summary_writer", "shipment_writer", "audit_writer"]-      map (.checkpointOnMissing) owners `shouldBe` [[], [], [CheckpointFromCurrentHead]]--    it "validates and truthfully lowers every Language 5 delivery/freshness capability" $ do-      entireSource <- readTestText "test/fixtures/mapped-readmodel.keiro"-      categorySource <- readTestText "test/fixtures/declarative-router/valid.keiro"-      immediateSource <- readTestText "test/fixtures/projection-catalog.keiro"-      entireService <- checkedServiceFromText "projection-freshness-entire.keiro" entireSource-      categoryService <- checkedServiceFromText "projection-freshness-category.keiro" categorySource-      immediateService <- checkedServiceFromText "projection-freshness-immediate.keiro" immediateSource-      let errorsOf service = [diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]-      errorsOf entireService `shouldBe` []-      errorsOf categoryService `shouldBe` []-      errorsOf immediateService `shouldBe` []-      let generatedReadModel suffix service =-            generatedTextEndingIn suffix (scaffoldServiceModules (defaultContext ((checkedSpec service).context)) service)-          entireReadModel = generatedReadModel "AccountSummary/ReadModel.hs" entireService-          categoryReadModel = generatedReadModel "HospitalLoad/ReadModel.hs" categoryService-          immediateReadModelText = generatedReadModel "CatalogAudit/ReadModel.hs" immediateService-          inlineReadModel = generatedReadModel "OrderInline/ReadModel.hs" immediateService-      entireReadModel `shouldSatisfy` T.isInfixOf "headWaitingReadModel EntireVisibleLog"-      entireReadModel `shouldSatisfy` T.isInfixOf "DurableQueryCursor \"mapped-readmodel-account-summary\""-      categoryReadModel `shouldSatisfy` T.isInfixOf "headWaitingReadModel (CategoryVisibleHead \"hospitalLoad\")"-      categoryReadModel `shouldSatisfy` T.isInfixOf "DurableQueryCursor \"declarative-router-hospital-load\""-      immediateReadModelText `shouldSatisfy` T.isInfixOf "immediateReadModel catalogAuditReadModelBlueprint"-      immediateReadModelText `shouldSatisfy` T.isInfixOf "DurableQueryCursor \"catalog-demo-audit\""-      inlineReadModel `shouldSatisfy` T.isInfixOf "immediateReadModel orderInlineReadModelBlueprint"-      inlineReadModel `shouldSatisfy` T.isInfixOf "cursorAuthority = NoQueryCursor"-      forM_ [entireReadModel, categoryReadModel, immediateReadModelText, inlineReadModel] $ \generated -> do-        generated `shouldNotSatisfy` T.isInfixOf "defaultConsistency"-        generated `shouldNotSatisfy` T.isInfixOf "strongScope"-        generated `shouldNotSatisfy` T.isInfixOf "subscriptionName ="--    it "rejects unavailable or unreachable head waits before generation" $ do-      catalogSource <- readTestText "test/fixtures/projection-catalog.keiro"-      categorySource <- readTestText "test/fixtures/declarative-router/valid.keiro"-      let codesFor name source = do-            service <- checkedServiceFromText name source-            pure [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]-          inlineWait =-            T.replace-              "shape = \"fnv1a:784e511a19f74c58\"\n  freshness = immediate\n  group = reporting\n  targets = [ order_summary ]"-              "shape = \"fnv1a:784e511a19f74c58\"\n  freshness = wait-for-head category \"orders\"\n  group = reporting\n  targets = [ order_summary ]"-              catalogSource-          mismatchedCategory =-            T.replace-              "freshness = wait-for-head category \"hospitalLoad\""-              "freshness = wait-for-head category \"other\""-              categorySource-          missingCursor = T.replace "  subscription = \"declarative-router-hospital-load\"\n" "" categorySource-      codesFor "projection-freshness-inline-wait.keiro" inlineWait-        `shouldReturn` [CatalogQueryWaitWithoutCompatibleCursor]-      codesFor "projection-freshness-mismatched-category.keiro" mismatchedCategory-        `shouldReturn` [CatalogQueryWaitWithoutCompatibleCursor]-      missingCursorCodes <- codesFor "projection-freshness-missing-cursor.keiro" missingCursor-      missingCursorCodes `shouldContain` [CatalogAsyncIdentityMissing]-      missingCursorCodes `shouldContain` [CatalogQueryWaitWithoutCompatibleCursor]--      mappedSource <- mappedConsumerSurfaceSource-      let implicitOwner =-            T.replace-              "  wire kind=ctorName fields=camelCase schemaVersion=1\n"-              "  wire kind=ctorName fields=camelCase schemaVersion=1\n\n  projection ArtifactLookup key=currentArtifact\n    status-map { ArtifactObserved=>observed }\n"-              ( T.replace-                  "freshness = immediate"-                  "freshness = wait-for-head category \"catalog\""-                  mappedSource-              )-      implicitCodes <- codesFor "projection-freshness-implicit-owner.keiro" implicitOwner-      implicitCodes `shouldContain` [CatalogQueryWaitWithoutCompatibleCursor]--    it "rejects the earlier Language 5 spellings with migration guidance" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      let failureText name candidate = case parseSource name candidate of-            Left failure -> pure (renderParseFailure failure)-            Right _ -> expectationFailure (name <> " unexpectedly parsed") >> fail "unreachable"-      readModelFailure <--        failureText-          "projection-freshness-legacy-readmodel.keiro"-          ( T.replace-              "  freshness = immediate"-              "  consistency = Strong\n  scope = entire-log\n  feed = subscription\n  subscription = \"catalog-demo-audit\""-              source-          )-      readModelFailure `shouldSatisfy` T.isInfixOf "remove legacy `consistency`"-      ownerFailure <--        failureText-          "projection-freshness-legacy-owner.keiro"-          (T.replace "  delivery = subscription" "  feed = subscription" source)-      ownerFailure `shouldSatisfy` T.isInfixOf "replace legacy `feed`"--      mappedSource <- mappedConsumerSurfaceSource-      aggregateFailure <--        failureText-          "projection-freshness-legacy-inner.keiro"-          ( T.replace-              "  wire kind=ctorName fields=camelCase schemaVersion=1\n"-              "  wire kind=ctorName fields=camelCase schemaVersion=1\n\n  projection ArtifactLookup consistency=Eventual key=currentArtifact\n    status-map { ArtifactObserved=>observed }\n"-              mappedSource-          )-      aggregateFailure `shouldSatisfy` T.isInfixOf "put `freshness` on the referenced readmodel"--    it "isolates freshness evolution from delivery, table shape, sources, and aggregate folds" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      baseline <- checkedServiceFromText "projection-freshness-baseline.keiro" source-      changed <--        checkedServiceFromText-          "projection-freshness-changed.keiro"-          ( T.replace-              "shape = \"fnv1a:9682af3ada04bf50\"\n  freshness = immediate\n  group = reporting\n  targets = [ audit_log ]"-              "shape = \"fnv1a:9682af3ada04bf50\"\n  freshness = wait-for-head category \"audit\"\n  group = reporting\n  targets = [ audit_log ]"-              source-          )-      validateService changed `shouldBe` []-      let changeCodes = map ((.code) . kindOfChange) (diffServices baseline changed)-          foldIdentities service =-            [ ((.name) aggregate, aggregateFoldFingerprintForService service aggregate)-            | NAggregate aggregate <- (.nodes) (checkedSpec service)-            ]-          sourceIdentities service =-            [ ((.name) aggregate, ProjectionImpact.projectionAggregateSourceFingerprintForService service ((.name) aggregate))-            | NAggregate aggregate <- (.nodes) (checkedSpec service)-            ]-          catalogAudit service = case [readModel | NReadModel readModel <- (.nodes) (checkedSpec service), (.name) readModel == "catalogAudit"] of-            [readModel] -> readModel-            values -> error ("expected one catalogAudit read model, got " <> show (length values))-          nonFreshnessFacts = filter (not . T.isPrefixOf "freshness|") . projectionCatalogFactsForService-          freshnessFacts = filter (T.isPrefixOf "freshness|") . projectionCatalogFactsForService-      changeCodes `shouldContain` [QueryFreshnessChanged]-      changeCodes `shouldNotContain` [ProjectionDeliveryChanged, ReadModelShapeChangedWithoutBump, CatalogSourceChanged]-      foldIdentities changed `shouldBe` foldIdentities baseline-      sourceIdentities changed `shouldBe` sourceIdentities baseline-      deriveShapeHash (catalogAudit changed) `shouldBe` deriveShapeHash (catalogAudit baseline)-      nonFreshnessFacts changed `shouldBe` nonFreshnessFacts baseline-      freshnessFacts changed `shouldNotBe` freshnessFacts baseline--    it "resolves one inline owner for several query models without legacy aggregate clauses" $ do-      source <- readTestText "test/fixtures/projection-owner-multi-query.keiro"-      service <- checkedServiceFromText "projection-owner-multi-query.keiro" source-      validateService service `shouldBe` []-      let analysis = analyzeProjectionSupplies (checkedSpec service)-          supplies = (.resolvedProjectionSupplies) analysis-      (.projectionSupplyIssues) analysis `shouldBe` []-      map (.queryModel) supplies-        `shouldBe` ["catalog_administration", "catalog_validation"]-      map (.projectionOwner) supplies-        `shouldBe` ["catalog_writer", "catalog_writer"]-      map (NE.toList . (.observedTargets)) supplies-        `shouldBe` [["catalog_keys"], ["catalog_layouts", "catalog_state"]]--      reordered <--        checkedServiceFromText-          "projection-owner-multi-query-reordered.keiro"-          ( T.replace-              "targets = [ catalog_state catalog_layouts ]"-              "targets = [ catalog_layouts catalog_state ]"-              ( T.replace-                  "targets = [ catalog_state catalog_layouts catalog_keys ]\n  order = 10"-                  "targets = [ catalog_keys catalog_layouts catalog_state ]\n  order = 10"-                  source-              )-          )-      validateService reordered `shouldBe` []-      (.resolvedProjectionSupplies) (analyzeProjectionSupplies (checkedSpec reordered))-        `shouldBe` supplies--    it "diagnoses invalid query supply and catalog/legacy double ownership deterministically" $ do-      source <- readTestText "test/fixtures/projection-owner-multi-query.keiro"-      let diagnosticsForSource caseName mutated = do-            service <- checkedServiceFromText caseName mutated-            pure (validateService service)-          codesForSource caseName mutated = map (.code) <$> diagnosticsForSource caseName mutated-          splitOwnerMutation =-            T.replace-              "targets = [ catalog_state catalog_layouts ]\n  backing = catalog_state"-              "targets = [ catalog_state catalog_layouts catalog_keys ]\n  backing = catalog_state"-              . T.replace-                "  replay = explicit\n}\n\nreadmodel catalog_validation"-                "  replay = explicit\n}\n\nprojection-owner catalog_keys_writer {\n  source = aggregate Catalog\n  delivery = inline\n  group = catalog_group\n  targets = [ catalog_keys ]\n  order = 20\n  replay = explicit\n}\n\nreadmodel catalog_validation"-              . T.replace-                "targets = [ catalog_state catalog_layouts catalog_keys ]\n  order = 10"-                "targets = [ catalog_state catalog_layouts ]\n  order = 10"-      emptyCodes <- codesForSource "projection-owner-empty-query.keiro" (T.replace "targets = [ catalog_keys ]" "targets = [ ]" source)-      emptyCodes `shouldContain` [CatalogReadModelBindingMissing]-      unknownCodes <- codesForSource "projection-owner-unknown-query-target.keiro" (T.replace "targets = [ catalog_keys ]" "targets = [ missing_target ]" source)-      unknownCodes `shouldContain` [CatalogTargetUnknown]-      missingCodes <- codesForSource "projection-owner-missing-query-owner.keiro" (T.replace "targets = [ catalog_state catalog_layouts catalog_keys ]\n  order = 10" "targets = [ catalog_state catalog_layouts ]\n  order = 10" source)-      missingCodes `shouldContain` [CatalogTargetUnowned]--      splitDiagnostics <- diagnosticsForSource "projection-owner-split-query.keiro" (splitOwnerMutation source)-      map (.code) splitDiagnostics `shouldContain` [CatalogReadModelMultipleSuppliers]-      let splitSupplyDiagnostics = filter ((== CatalogReadModelMultipleSuppliers) . (.code)) splitDiagnostics-      map (map snd . (.relatedLocations)) splitSupplyDiagnostics-        `shouldBe` [ [ "projection owner 'catalog_keys_writer' supplies part of the observed target set",-                       "projection owner 'catalog_writer' supplies part of the observed target set"-                     ]-                   ]-      reorderedSplitDiagnostics <--        diagnosticsForSource-          "projection-owner-split-query-reordered.keiro"-          ( T.replace-              "targets = [ catalog_state catalog_layouts catalog_keys ]"-              "targets = [ catalog_keys catalog_layouts catalog_state ]"-              (splitOwnerMutation source)-          )-      map (\diagnostic -> ((.code) diagnostic, map snd ((.relatedLocations) diagnostic))) reorderedSplitDiagnostics-        `shouldContain` map (\diagnostic -> ((.code) diagnostic, map snd ((.relatedLocations) diagnostic))) splitSupplyDiagnostics--      groupMismatchCodes <--        codesForSource-          "projection-owner-group-mismatch.keiro"-          ( T.replace-              "targets = [ catalog_state catalog_layouts catalog_keys ]\n  order = [ catalog_state catalog_layouts catalog_keys ]\n}"-              "targets = [ catalog_state catalog_layouts ]\n  order = [ catalog_state catalog_layouts ]\n}\n\nrebuild-group catalog_keys_group {\n  targets = [ catalog_keys ]\n  order = [ catalog_keys ]\n}"-              source-          )-      groupMismatchCodes `shouldContain` [CatalogReadModelTargetOutsideGroup]-      groupMismatchCodes `shouldContain` [CatalogProjectionTargetOutsideGroup]--      conflictDiagnostics <--        diagnosticsForSource-          "projection-owner-legacy-conflict.keiro"-          ( T.replace-              "  wire kind=ctorName fields=camelCase schemaVersion=1"-              "  wire kind=ctorName fields=camelCase schemaVersion=1\n\n  projection catalog_validation key=version\n    status-map { Activated=>active }"-              source-          )-      let conflicts = filter ((== CatalogReadModelLegacyProjectionConflict) . (.code)) conflictDiagnostics-      length conflicts `shouldBe` 1-      conflicts `shouldSatisfy` all ((== 1) . length . (.relatedLocations))-      conflicts `shouldSatisfy` all (T.isInfixOf "remove the legacy aggregate projection clause" . (.message))--    it "derives and restores mapped projection impact for the compiled A/B catalog fixture" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      service <- checkedServiceFromText "projection-catalog.keiro" source-      baseImpact <- case ProjectionImpact.projectionMappedImpactForService service of-        Nothing -> expectationFailure "projection fixture type graph did not resolve" >> fail "unreachable"-        Just value -> pure value-      ProjectionImpact.projectionConsumersFor baseImpact (MappedKey "OrderPayload")-        `shouldBe` Set.singleton (CatalogProjectionConsumer "order_summary_writer" "Orders")-      ProjectionImpact.projectionConsumersFor baseImpact (MappedKey "SharedReference")-        `shouldBe` Set.fromList-          [ CatalogProjectionConsumer "order_summary_writer" "Orders",-            CatalogProjectionConsumer "shipment_writer" "Shipments"-          ]-      (.unsupported) baseImpact-        `shouldBe` [ ProjectionImpact.UnsupportedProjectionImpact-                       (UnsupportedCatalogCategory "audit_writer" "audit")-                       "reporting"-                       (Set.singleton "audit_log")-                       (Set.singleton "catalogAudit")-                       True-                   ]-      let rendered = ProjectionImpact.renderProjectionMappedImpact baseImpact-      rendered `shouldContain` ["      inherited event roots: Orders event OrderRecorded .orderPayload : OrderPayload"]-      rendered-        `shouldContain` ["      operation: group=shipping; targets=shipment_summary; read-models=shipmentLookup; replayable=no; source-fingerprint=aggregate:Shipments/generated-codec/v1/mapped-9456a95e380c74b5"]-      rendered `shouldContain` ["    catalog-category:audit_writer:audit"]--      eventChanged <- checkedServiceFromText "projection-catalog-event-changed.keiro" (T.replace "version = \"1\"" "version = \"2\"" source)-      sourceChanged <- checkedServiceFromText "projection-catalog-source-changed.keiro" (T.replace "source = aggregate Orders" "source = aggregate Shipments" source)-      replayChanged <- checkedServiceFromText "projection-catalog-replay-changed.keiro" (T.replace "replay = live-only \"carrier events cannot be replayed\"" "replay = explicit" source)-      observationChanged <- checkedServiceFromText "projection-catalog-observation-changed.keiro" (T.replace "targets = [ order_summary ]" "targets = [ audit_log ]" source)-      categoryChanged <- checkedServiceFromText "projection-catalog-category-changed.keiro" (T.replace "source = category \"audit\"" "source = category \"archive-audit\"" source)-      let requireImpact caseLabel candidate = case ProjectionImpact.projectionMappedImpactForService candidate of-            Nothing -> expectationFailure (caseLabel <> " type graph did not resolve") >> fail "unreachable"-            Just value -> pure value-          findOperation derived impact =-            Map.lookup derived ((.operations) impact)-          operationReplay (ProjectionImpact.ProjectionOperationalImpact _ _ _ _ canReplay _) = canReplay-          operationObservers (ProjectionImpact.ProjectionOperationalImpact _ _ _ observers _ _) = observers-          operationFingerprint (ProjectionImpact.ProjectionOperationalImpact _ _ _ _ _ fingerprint) = fingerprint-      eventImpact <- requireImpact "event mutation" eventChanged-      sourceImpact <- requireImpact "source mutation" sourceChanged-      replayImpact <- requireImpact "replay mutation" replayChanged-      observationImpact <- requireImpact "observation mutation" observationChanged-      categoryImpact <- requireImpact "category mutation" categoryChanged-      operationFingerprint <$> findOperation (CatalogProjectionConsumer "order_summary_writer" "Orders") eventImpact-        `shouldNotBe` operationFingerprint <$> findOperation (CatalogProjectionConsumer "order_summary_writer" "Orders") baseImpact-      ProjectionImpact.projectionConsumersFor sourceImpact (MappedKey "OrderPayload")-        `shouldBe` Set.empty-      operationReplay <$> findOperation (CatalogProjectionConsumer "shipment_writer" "Shipments") replayImpact-        `shouldBe` Just True-      operationObservers <$> findOperation (CatalogProjectionConsumer "order_summary_writer" "Orders") observationImpact-        `shouldBe` Just (Set.singleton "order_totals_lookup")-      map (.source) ((.unsupported) categoryImpact)-        `shouldBe` [UnsupportedCatalogCategory "audit_writer" "archive-audit"]-      restored <- checkedServiceFromText "projection-catalog-restored.keiro" source >>= requireImpact "restored fixture"-      restored `shouldBe` baseImpact--    it "feature-gates catalog declarations before validation in languages 1-4" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      case parseSource "projection-catalog-v4.keiro" (T.replace "language keiro-dsl 5" "language keiro-dsl 4" source) of-        Left failure -> do-          renderParseFailure failure `shouldSatisfy` T.isInfixOf "LanguageFeatureRequiresVersion"-          renderParseFailure failure `shouldSatisfy` T.isInfixOf "requires keiro-dsl language version 5"-        Right _ -> expectationFailure "language 4 accepted projection-catalog syntax"--    it "keeps the catalog structural guards live" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      let mutationCodes mutation = do-            service <- checkedServiceFromText "projection-catalog-mutation.keiro" (mutation source)-            pure (map (.code) (validateService service))-          revisionV2AuditBlock =-            T.unlines-              [ "  target audit_log {",-                "    schema-version = \"v2\"",-                "    provisioner = \"reporting-v2-audit-log\"",-                "    provisioner-version = 1",-                "    expected-shape = \"audit-log-v2\"",-                "    validator = \"reporting-v2-audit-log-validator\"",-                "    validator-version = 1",-                "    promotion owned-sequence \"audit_log_id_seq__v2\" -> \"audit_log_id_seq\"",-                "  }"-              ]-      missingAsyncIdentity <- mutationCodes (T.replace "  subscription = \"catalog-demo-audit\"\n" "")-      missingAsyncIdentity `shouldContain` [CatalogAsyncIdentityMissing]-      missingCheckpointPolicy <- mutationCodes (T.replace "  checkpoint-on-missing = from-current-head\n" "")-      missingCheckpointPolicy `shouldContain` [CatalogCheckpointPolicyMissing]-      duplicateCheckpointPolicy <- mutationCodes (T.replace "  checkpoint-on-missing = from-current-head\n" "  checkpoint-on-missing = from-current-head\n  checkpoint-on-missing = fail\n")-      duplicateCheckpointPolicy `shouldContain` [CatalogCheckpointPolicyDuplicate]-      unexpectedInlineCheckpointPolicy <- mutationCodes (T.replace "  order = 10\n  replay = explicit" "  order = 10\n  checkpoint-on-missing = from-beginning\n  replay = explicit")-      unexpectedInlineCheckpointPolicy `shouldContain` [CatalogCheckpointPolicyUnexpected]-      replayUnsafeCheckpointPolicy <- mutationCodes (T.replace "table = \"audit_log\"\n  reset = preserve" "table = \"audit_log\"\n  reset = clear")-      replayUnsafeCheckpointPolicy `shouldContain` [CatalogCheckpointPolicyReplayUnsafe]-      case parseSource "projection-catalog-unknown-checkpoint-policy.keiro" (T.replace "checkpoint-on-missing = from-current-head" "checkpoint-on-missing = newest" source) of-        Left failure -> do-          let rendered = renderParseFailure failure-          rendered `shouldSatisfy` T.isInfixOf "unknown checkpoint-on-missing policy"-          rendered `shouldSatisfy` T.isInfixOf "from-beginning"-          rendered `shouldSatisfy` T.isInfixOf "from-current-head"-          rendered `shouldSatisfy` T.isInfixOf "fail"-        Right _ -> expectationFailure "unknown checkpoint-on-missing value parsed successfully"-      forM_ ["from-beginning", "fail"] $ \policy -> do-        acceptedPolicy <- mutationCodes (T.replace "checkpoint-on-missing = from-current-head" ("checkpoint-on-missing = " <> policy))-        acceptedPolicy `shouldNotContain` [CatalogCheckpointPolicyMissing, CatalogCheckpointPolicyDuplicate, CatalogCheckpointPolicyUnexpected, CatalogCheckpointPolicyReplayUnsafe]-        acceptedClearPolicy <- mutationCodes (T.replace "table = \"audit_log\"\n  reset = preserve" "table = \"audit_log\"\n  reset = clear" . T.replace "checkpoint-on-missing = from-current-head" ("checkpoint-on-missing = " <> policy))-        acceptedClearPolicy `shouldNotContain` [CatalogCheckpointPolicyReplayUnsafe]-      unsafeLiveOnly <- mutationCodes (T.replace "  replay = explicit\n}" "  replay = live-only \"external side effect\"\n}")-      unsafeLiveOnly `shouldContain` [CatalogClearTargetLiveOnly]-      duplicateOrder <- mutationCodes (T.replace "  order = 20\n" "  order = 10\n")-      duplicateOrder `shouldContain` [CatalogDuplicateHandlerOrder]-      badGroupOrder <- mutationCodes (T.replace "  order = [ order_summary order_totals audit_log ]" "  order = [ order_summary order_summary audit_log ]")-      badGroupOrder `shouldContain` [CatalogGroupOrderMismatch]-      missingOwner <- mutationCodes (T.replace "  targets = [ order_summary order_totals ]\n" "  targets = [ order_summary ]\n")-      missingOwner `shouldContain` [CatalogTargetUnowned]-      unknownDependency <- mutationCodes (T.replace "  depends-on = [ order_summary ]\n" "  depends-on = [ missing_target ]\n")-      unknownDependency `shouldContain` [CatalogTargetDependencyUnknown]-      dependencyCycle <- mutationCodes (T.replace "  reset = clear\n}\n\ntarget audit_log" "  reset = clear\n  depends-on = [ order_totals ]\n}\n\ntarget audit_log")-      dependencyCycle `shouldContain` [CatalogTargetDependencyCycle]-      overlappingSource <- mutationCodes (T.replace "  source = aggregate Orders\n" "  source = aggregate Orders\n  source = category \"orders\"\n")-      overlappingSource `shouldContain` [CatalogSourceOverlap]-      ambiguousSourceOrdering <- mutationCodes (T.replace "  source = category \"audit\"\n" "  source = all\n")-      ambiguousSourceOrdering `shouldContain` [CatalogAmbiguousSourceOrdering]-      missingQueryBinding <- mutationCodes (T.replace "  targets = [ audit_log ]\n}\n\nprojection-owner audit_writer" "  targets = [ order_summary ]\n}\n\nprojection-owner audit_writer")-      missingQueryBinding `shouldContain` [CatalogAsyncQueryBindingMissing]-      missingRevisionTarget <- mutationCodes (T.replace "  target audit_log {\n    schema-version = \"v2\"" "  target missing_target {\n    schema-version = \"v2\"")-      missingRevisionTarget `shouldContain` [CatalogRevisionTargetUnknown, CatalogRevisionTargetSetMismatch]-      incompleteRevision <- mutationCodes (T.replace revisionV2AuditBlock "")-      incompleteRevision `shouldContain` [CatalogRevisionTargetSetMismatch]-      invalidRevisionIdentity <- mutationCodes (T.replace "provisioner-version = 1" "provisioner-version = 0")-      invalidRevisionIdentity `shouldContain` [CatalogRevisionIdentityInvalid]-      invalidContractVersion <- mutationCodes (T.replace "external-read order_totals_reader {\n  version = 1" "external-read order_totals_reader {\n  version = 0")-      invalidContractVersion `shouldContain` [CatalogExternalReadVersionInvalid]-      missingExternalQuery <- mutationCodes (T.replace "query = order_totals_lookup" "query = missing_query")-      missingExternalQuery `shouldContain` [CatalogExternalReadQueryUnknown]-      multiTargetExternalQuery <- mutationCodes (T.replace "  targets = [ order_totals ]\n}\n\nexternal-read" "  targets = [ order_summary order_totals ]\n  backing = order_totals\n}\n\nexternal-read")-      multiTargetExternalQuery `shouldContain` [CatalogExternalReadTargetCardinalityInvalid]-      emptyCompatibility <- mutationCodes (T.replace "compatible-revisions = [ reporting_v1 reporting_v2 ]" "compatible-revisions = [ ]")-      emptyCompatibility `shouldContain` [CatalogExternalReadCompatibilityInvalid]-      unknownCompatibleRevision <- mutationCodes (T.replace "compatible-revisions = [ reporting_v1 reporting_v2 ]" "compatible-revisions = [ missing_revision ]")-      unknownCompatibleRevision `shouldContain` [CatalogExternalReadRevisionUnknown]-      wrongRevisionGroup <- mutationCodes (T.replace "query = order_totals_lookup" "query = shipmentLookup")-      wrongRevisionGroup `shouldContain` [CatalogExternalReadRevisionGroupMismatch]-      invalidResultIdentity <- mutationCodes (T.replace "result-schema = \"app_contract\"" "result-schema = \"app-contract\"")-      invalidResultIdentity `shouldContain` [CatalogExternalReadIdentityInvalid]-      invalidSurfaceGeneration <- mutationCodes (T.replace "surface-generation = 1" "surface-generation = 0")-      invalidSurfaceGeneration `shouldContain` [CatalogExternalReadSurfaceGenerationInvalid]--    it "generates one facade, one create-once behavior surface, and durable ledger facts" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      service <- checkedServiceFromText "projection-catalog.keiro" source-      let spec = checkedSpec service-          modules = scaffoldServiceModules (defaultContext (spec.context)) service-          facade = generatedTextEndingIn "Generated/CatalogDemo/ProjectionCatalog.hs" modules-          holes = case [(.text) m | m <- modules, (.kind) m == HoleStub, "ProjectionCatalog/ProjectionCatalogHoles.hs" `T.isSuffixOf` T.pack ((.path) m)] of-            [value] -> value-            values -> error ("expected one projection catalog hole module, got " <> show (length values))-          facts = projectionCatalogFactsForService service-      facade `shouldSatisfy` T.isInfixOf "Catalog.validateProjectionCatalog projectionCatalog"-      facade `shouldSatisfy` T.isInfixOf "Catalog.ClearBeforeReplay"-      facade `shouldSatisfy` T.isInfixOf "Catalog.PreserveAndReconcile"-      facade `shouldSatisfy` T.isInfixOf "KirokuSubscription.FromCurrentHead"-      facade `shouldSatisfy` T.isInfixOf "Catalog.ProjectionRevision (must (Catalog.mkProjectionRevisionId \"reporting_v1\"))"-      facade `shouldSatisfy` T.isInfixOf "Catalog.TargetSchemaVersion \"v2\""-      facade `shouldSatisfy` T.isInfixOf "Catalog.AllRowsExternalRead (must (Catalog.mkExternalReadContractId \"order_totals_reader\"))"-      facade `shouldSatisfy` T.isInfixOf "Catalog.QualifiedSqlType \"app_contract\" \"order_totals_row_v1\""-      facade `shouldSatisfy` T.isInfixOf "\"fnv1a:768a23d719dcb4d4\""-      facade `shouldSatisfy` T.isInfixOf "projectionCatalogQuerySupplies = Catalog.resolvedQuerySupplies validatedProjectionCatalog"-      facade `shouldSatisfy` T.isInfixOf "ordersInlineProjections = concat [orderSummaryWriterInlineProjections]"-      facade-        `shouldSatisfy` ( \text ->-                            let (_, fromFirst) = T.breakOn "orderSummaryWriterProjectionSet" text-                             in not (T.null fromFirst) && T.isInfixOf "auditWriterProjectionSet" (T.drop 1 fromFirst)-                        )-      holes `shouldSatisfy` T.isInfixOf "fill order_summary_writer live apply"-      holes `shouldSatisfy` T.isInfixOf "fill order_summary_writer replay apply"-      holes `shouldSatisfy` T.isInfixOf "provisionReportingV2OrderSummary :: Catalog.TargetProvisioningContext"-      holes `shouldSatisfy` T.isInfixOf "applyReportingV2OrderSummaryWriterLive :: Catalog.PhysicalTargets"-      holes `shouldSatisfy` T.isInfixOf "applyReportingV2AuditWriterLive :: Catalog.PhysicalTargets"-      holes `shouldSatisfy` T.isInfixOf "orderTotalsReaderV1KeyedExternalRead :: [Catalog.SqlFunctionArgument]"-      holes `shouldSatisfy` T.isInfixOf "application-owned private SQL function"-      facts `shouldBe` sort facts-      facts `shouldSatisfy` any (T.isPrefixOf "target|order_summary|")-      facts `shouldSatisfy` any (T.isPrefixOf "owner|audit_writer|")-      facts `shouldSatisfy` any (T.isPrefixOf "delivery|audit_writer|subscription|")-      facts `shouldSatisfy` any (T.isPrefixOf "revision|reporting_v1|reporting|")-      facts `shouldSatisfy` any (T.isPrefixOf "external-read|order_totals_reader|1|order_totals_lookup|app_contract.order_totals_row_v1|fnv1a:768a23d719dcb4d4|reporting_v1,reporting_v2|1|")-      facts `shouldSatisfy` any (T.isInfixOf "order_summary,v2,reporting-v2-order-summary")-      facts `shouldSatisfy` any (T.isPrefixOf "freshness|catalogAudit|immediate|")-      facts `shouldSatisfy` any (T.isPrefixOf "cursor|catalogAudit|catalog-demo-audit|")-      facts `shouldSatisfy` any (T.isPrefixOf "query|order_totals_lookup|reporting|order_totals|order_totals|")-      facts `shouldSatisfy` any (T.isPrefixOf "supply|order_inline|order_summary_writer|reporting|order_summary|")-      facts `shouldSatisfy` any (T.isPrefixOf "supply|order_totals_lookup|order_summary_writer|reporting|order_totals|")-      facts `shouldSatisfy` any (T.isInfixOf "|from-current-head|explicit|")--    it "distinguishes external-read versioning, retirement, compatibility, and derived result-shape changes" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      baseline <- checkedServiceFromText "projection-catalog-external-read.keiro" source-      let externalReadBlock version resultType =-            T.unlines-              [ "external-read order_totals_reader {",-                "  version = " <> T.pack (show version),-                "  query = order_totals_lookup",-                "  result-schema = \"app_contract\"",-                "  result-type = \"" <> resultType <> "\"",-                "  compatible-revisions = [ reporting_v1 reporting_v2 ]",-                "  surface-generation = 1",-                "}",-                ""-              ]-          v1Block = externalReadBlock (1 :: Int) "order_totals_row_v1"-          codes candidate = map ((.code) . kindOfChange) (diffServices baseline candidate)-      versionAdded <--        checkedServiceFromText-          "projection-catalog-external-read-v2.keiro"-          (T.replace v1Block (v1Block <> externalReadBlock (2 :: Int) "order_totals_row_v2") source)-      retired <- checkedServiceFromText "projection-catalog-external-read-retired.keiro" (T.replace v1Block "" source)-      compatibilityChanged <--        checkedServiceFromText-          "projection-catalog-external-read-compatible.keiro"-          (T.replace "compatible-revisions = [ reporting_v1 reporting_v2 ]" "compatible-revisions = [ reporting_v1 ]" source)-      shapeChanged <--        checkedServiceFromText-          "projection-catalog-external-read-shape.keiro"-          (T.replace "shape = \"fnv1a:768a23d719dcb4d4\"" "shape = \"fnv1a:0000000000000000\"" source)-      validateService versionAdded `shouldBe` []-      codes versionAdded `shouldContain` [CatalogExternalReadVersionAdded]-      codes retired `shouldContain` [CatalogExternalReadRetired]-      codes compatibilityChanged `shouldContain` [CatalogExternalReadCompatibilityChanged]-      codes shapeChanged `shouldContain` [CatalogExternalReadResultShapeChanged]--      reordered <--        checkedServiceFromText-          "projection-catalog-external-read-reordered.keiro"-          (T.replace "compatible-revisions = [ reporting_v1 reporting_v2 ]" "compatible-revisions = [ reporting_v2 reporting_v1 ]" source)-      projectionCatalogFactsForService reordered `shouldBe` projectionCatalogFactsForService baseline-      codes reordered `shouldNotContain` [CatalogExternalReadCompatibilityChanged]--    it "preserves edited catalog behavior holes on regeneration" $-      withTempDirectory "keiro-dsl-projection-catalog-create-once" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/projection-catalog.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            holeSuffix = "ProjectionCatalog/ProjectionCatalogHoles.hs"-        modules <- case planTestServiceScaffold ctx service of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right planned -> pure planned-        first <- executeServiceScaffold out False "projection-catalog.keiro" ((.sourceLanguage) parsed) ctx service modules-        first `shouldSatisfy` isSuccessfulScaffold-        let path = out </> onlyPathEndingIn holeSuffix modules-            reviewedBody = "module CatalogDemo.ProjectionCatalog.ProjectionCatalogHoles where\nreviewed = True\n"-        TIO.writeFile path reviewedBody-        second <- executeServiceScaffold out False "projection-catalog.keiro" ((.sourceLanguage) parsed) ctx service modules-        second `shouldSatisfy` isSuccessfulScaffold-        TIO.readFile path `shouldReturn` reviewedBody-        case second of-          Left _ -> fail "unreachable"-          Right report ->-            do-              (.dispositions) report-                `shouldSatisfy` any (\(moduleValue, disposition) -> holeSuffix `isSuffixOfPath` moduleValue && disposition == Skipped)-              renderScaffoldReport report-                `shouldContain` ["      inherited event roots: Orders event OrderRecorded .orderPayload : OrderPayload"]-              renderScaffoldReport report-                `shouldContain` ["      operation: group=shipping; targets=shipment_summary; read-models=shipmentLookup; replayable=no; source-fingerprint=aggregate:Shipments/generated-codec/v1/mapped-9456a95e380c74b5"]-              renderScaffoldReport report `shouldContain` ["    catalog-category:audit_writer:audit"]--    it "classifies every catalog evolution dimension and reports machine-readable replay impact" $ do-      source <- readTestText "test/fixtures/projection-catalog.keiro"-      oldService <- checkedServiceFromText "projection-catalog-old.keiro" source-      let targetBlock = T.unlines ["target audit_log {", "  schema = \"sales\"", "  table = \"audit_log\"", "  reset = preserve", "}", ""]-          ownerBlock =-            T.unlines-              [ "projection-owner audit_writer {",-                "  source = category \"audit\"",-                "  delivery = subscription",-                "  group = reporting",-                "  targets = [ audit_log ]",-                "  order = 20",-                "  subscription = \"catalog-demo-audit\"",-                "  dedup = \"catalog-demo-audit-v1\"",-                "  checkpoint-on-missing = from-current-head",-                "  replay = explicit",-                "}",-                ""-              ]-          mutations =-            [ ("target-added", CatalogTargetAdded, T.replace "rebuild-group reporting" "target archive_log {\n  schema = \"sales\"\n  table = \"archive_log\"\n  reset = preserve\n}\n\nrebuild-group reporting"),-              ("target-removed", CatalogTargetRemoved, T.replace targetBlock ""),-              ("target-location", CatalogTargetLocationChanged, T.replace "table = \"order_summary\"" "table = \"order_summary_v2\""),-              ("target-reset", CatalogTargetResetPolicyChanged, T.replace "reset = preserve" "reset = clear"),-              ("target-dependency", CatalogTargetDependencyChanged, T.replace "depends-on = [ order_summary ]" "depends-on = [ audit_log ]"),-              ("group-membership-order", CatalogGroupChanged, T.replace "order = [ order_summary order_totals audit_log ]" "order = [ audit_log order_summary order_totals ]"),-              ("revision-schema", CatalogTargetSchemaChanged, T.replace "schema-version = \"v2\"" "schema-version = \"v2.1\""),-              ("revision-provider", CatalogProjectionRevisionChanged, T.replace "provisioner = \"reporting-v2-order-summary\"" "provisioner = \"reporting-v2-order-summary-new\""),-              ("owner-binding", CatalogOwnerChanged, T.replace "targets = [ order_summary order_totals ]" "targets = [ order_summary ]"),-              ("owner-removed", CatalogOwnerRemoved, T.replace ownerBlock ""),-              ("handler-order", CatalogHandlerOrderChanged, T.replace "order = 20" "order = 30"),-              ("source", CatalogSourceChanged, T.replace "source = aggregate Orders" "source = category \"archived-orders\""),-              ("delivery", ProjectionDeliveryChanged, T.replace "delivery = subscription" "delivery = inline"),-              ("subscription", CatalogFeedIdentityChanged, T.replace "subscription = \"catalog-demo-audit\"" "subscription = \"catalog-demo-audit-v2\""),-              ("dedup", CatalogFeedIdentityChanged, T.replace "dedup = \"catalog-demo-audit-v1\"" "dedup = \"catalog-demo-audit-v2\""),-              ("checkpoint-policy", CatalogCheckpointPolicyChanged, T.replace "checkpoint-on-missing = from-current-head" "checkpoint-on-missing = fail"),-              ("replay-policy", CatalogReplayPolicyChanged, T.replace "replay = live-only \"carrier events cannot be replayed\"" "replay = explicit"),-              ("query-binding", CatalogQueryBindingChanged, T.replace "targets = [ audit_log ]\n}\n\nprojection-owner audit_writer" "targets = [ order_summary ]\n}\n\nprojection-owner audit_writer")-            ]-      changedServices <--        forM mutations $ \(caseName, expectedCode, mutate) -> do-          changed <- checkedServiceFromText ("projection-catalog-" <> caseName <> ".keiro") (mutate source)-          map ((.code) . kindOfChange) (diffServices oldService changed) `shouldContain` [expectedCode]-          pure (caseName, changed)-      supplierChanged <--        checkedServiceFromText-          "projection-catalog-supplier-changed.keiro"-          ( T.replace-              "projection-owner audit_writer"-              ( T.unlines-                  [ "projection-owner order_totals_writer {",-                    "  source = category \"orderTotals\"",-                    "  delivery = inline",-                    "  group = reporting",-                    "  targets = [ order_totals ]",-                    "  order = 15",-                    "  replay = explicit",-                    "}",-                    "",-                    "projection-owner audit_writer"-                  ]-              )-              (T.replace "targets = [ order_summary order_totals ]" "targets = [ order_summary ]" source)-          )-      validateService supplierChanged `shouldBe` []-      map ((.code) . kindOfChange) (diffServices oldService supplierChanged)-        `shouldContain` [CatalogQueryBindingChanged]-      sourceChanged <- case lookup "source" changedServices of-        Just changed -> pure changed-        Nothing -> expectationFailure "source mutation was not exercised" >> fail "unreachable"-      policyChanged <- case lookup "checkpoint-policy" changedServices of-        Just changed -> pure changed-        Nothing -> expectationFailure "checkpoint policy mutation was not exercised" >> fail "unreachable"-      let policyChanges = [change | change <- diffServices oldService policyChanged, (.code) (kindOfChange change) == CatalogCheckpointPolicyChanged]-      case policyChanges of-        [change] -> do-          let finding = kindOfChange change-              rendered = renderFinding change-              encoded = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReport defaultGate [change])))-          (.persistedIdentity) (finding.vector) `shouldBe` VCompatible-          (.consumerBuild) (finding.vector) `shouldBe` VBreaking-          (.rollout) (finding.vector) `shouldBe` Set.singleton RolloutStopTheWorld-          (.detail) finding `shouldSatisfy` T.isInfixOf "existing checkpoint rows remain unchanged"-          rendered `shouldSatisfy` T.isInfixOf "from-current-head -> fail"-          rendered `shouldSatisfy` T.isInfixOf "rollout=stop-the-world"-          encoded `shouldSatisfy` T.isInfixOf "CatalogCheckpointPolicyChanged"-          encoded `shouldSatisfy` T.isInfixOf "from-current-head -> fail"-          encoded `shouldSatisfy` T.isInfixOf "\"persisted-identity\":\"compatible\""-          encoded `shouldSatisfy` T.isInfixOf "\"rollout\":[\"stop-the-world\"]"-        changes -> expectationFailure ("expected one checkpoint-policy finding, got " <> show (length changes))-      case ReplayImpact.catalogReplayImpactServices oldService policyChanged of-        CatalogReplayAffected groups targets sources adapters invalidates -> do-          groups `shouldBe` Set.singleton "reporting"-          targets `shouldBe` Set.singleton "audit_log"-          sources `shouldBe` Set.singleton "category:audit"-          adapters `shouldBe` Set.singleton "audit_writer"-          invalidates `shouldBe` True-        CatalogReplayNeutral -> expectationFailure "checkpoint-policy change was replay-neutral"-      case ReplayImpact.catalogReplayImpactServices oldService sourceChanged of-        CatalogReplayAffected groups targets sources adapters invalidates -> do-          groups `shouldBe` Set.singleton "reporting"-          targets `shouldBe` Set.fromList ["order_summary", "order_totals"]-          sources `shouldBe` Set.fromList ["aggregate:Orders", "category:archived-orders"]-          adapters `shouldBe` Set.singleton "order_summary_writer"-          invalidates `shouldBe` True-        CatalogReplayNeutral -> expectationFailure "catalog source change was replay-neutral"--  describe "ID domain" $ do-    let parseRight name source = case parseSource name source of-          Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-          Right value -> pure value--    it "registers language 3 as the first enforced runtime contract" $ do-      parsed <- case parseSource "id-domain-v3.keiro" "language keiro-dsl 3\ncontext id-domain\n" of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      let contract = checkedLanguageContract (checkedSource parsed)-      effectiveRuntimeSemantics contract `shouldBe` "keiro-dsl/runtime-semantics/2"-      (.contractLanguageVersion) contract `shouldBe` maybe (error "missing v3") id (languageVersion 3)-      idDomainContractFor contract "req" `shouldSatisfy` (/= Nothing)--    it "registers language 4 as contract admission semantics without changing aggregate ID admission" $ do-      v3 <- parseRight "id-domain-v3.keiro" "language keiro-dsl 3\ncontext id-domain\n"-      v4 <- parseRight "id-domain-v4.keiro" "language keiro-dsl 4\ncontext id-domain\n"-      let v3Contract = checkedLanguageContract (checkedSource v3)-          v4Contract = checkedLanguageContract (checkedSource v4)-      effectiveRuntimeSemantics v4Contract `shouldBe` "keiro-dsl/runtime-semantics/3"-      (.contractLanguageVersion) v4Contract `shouldBe` maybe (error "missing v4") id (languageVersion 4)-      idDomainContractFor v4Contract "req" `shouldBe` idDomainContractFor v3Contract "req"-      contractIdDomainContractFor v3Contract "req" `shouldBe` Nothing-      contractIdDomainContractFor v4Contract "req" `shouldBe` Just (typeIdV7Domain "req")--    it "constructs typed KindIDs only after the frozen four-way admission policy" $ do-      let valid = "req_01h455vb4pex5vsknk084sn02q"-          uppercase = "req_01H455VB4PEX5VSKNK084SN02Q"-          nonV7 = "req_00041061050r3gg28a1c60t3gf"-      (KindID.toText @"req" <$> parseKindIdV7Text @"req" valid) `shouldBe` Right valid-      parseKindIdV7Text @"req" "req-1" `shouldSatisfy` \case-        Left IdDomainMalformed {} -> True-        _ -> False-      parseKindIdV7Text @"req" "other_01h455vb4pex5vsknk084sn02q" `shouldSatisfy` \case-        Left (IdDomainWrongPrefix "req" "other") -> True-        _ -> False-      parseKindIdV7Text @"req" uppercase `shouldBe` Left IdDomainNonCanonical-      parseKindIdV7Text @"req" nonV7 `shouldSatisfy` \case-        Left IdDomainNotUuidV7 {} -> True-        _ -> False-      parseEither (parseKindIdV7Value @"req") (Aeson.String uppercase)-        `shouldSatisfy` \case-          Left problem -> "not canonical lowercase" `T.isInfixOf` T.pack problem-          Right _ -> False--    it "validates contract TypeID prefixes only at the language-4 boundary" $ do-      let source versionNumber =-            T.unlines-              [ "language keiro-dsl " <> T.pack (show versionNumber),-                "context invalid-contract-prefix",-                "contract emergency {",-                "  schemaVersion 1",-                "  discriminator messageType",-                "  topic incidentEvents \"emergency.incident.events\"",-                "  event IncidentDeclared on incidentEvents {",-                "    incidentId: typeid \"Bad\"",-                "  }",-                "}"-              ]-      v3 <- parseRight "contract-prefix-v3.keiro" (source (3 :: Int))-      v4 <- parseRight "contract-prefix-v4.keiro" (source (4 :: Int))-      validateService (checkedSource v3) `shouldBe` []-      case validateService (checkedSource v4) of-        [diagnostic] -> do-          (.code) diagnostic `shouldBe` ContractInvalidTypeIdPrefix-          (.line) diagnostic `shouldBe` 8-          (.message) diagnostic `shouldSatisfy` T.isInfixOf "contract 'emergency' event 'IncidentDeclared' field 'incidentId'"-          (.message) diagnostic `shouldSatisfy` T.isInfixOf "invalid TypeID prefix 'Bad'"-        diagnostics -> expectationFailure ("expected one invalid contract prefix diagnostic, got " <> show diagnostics)--    it "keeps version-3 and version-4 aggregate fold and replay semantics equal" $ do-      v3Text <- readTestText "test/fixtures/id-domain-migration-v3.keiro"-      v3 <- parseRight "fold-v3.keiro" v3Text-      v4 <- parseRight "fold-v4.keiro" (T.replace "language keiro-dsl 3" "language keiro-dsl 4" v3Text)-      let v3Service = checkedSource v3-          v4Service = checkedSource v4-          fingerprints service =-            [ aggregateFoldFingerprintForService service aggregate-            | NAggregate aggregate <- (.nodes) (checkedSpec service)-            ]-      fingerprints v4Service `shouldBe` fingerprints v3Service-      diffServices v3Service v4Service `shouldBe` []-      resolvedFold (ReplayImpact.replayImpactServices v3Service v4Service) `shouldBe` ReplayNeutral--    it "keeps runtime validation and the exact Keiki text image in agreement" $ do-      let contract = typeIdV7Domain "req"-          sampleText = idDomainSampleText contract-          suffix = T.drop (T.length "req_") sampleText-          replaceAt position replacement value =-            T.take position value <> T.singleton replacement <> T.drop (position + 1) value-          accepted =-            [ sampleText,-              replaceAt (T.length "req_" + 10) 'f' sampleText,-              replaceAt (T.length "req_" + 13) 'v' sampleText-            ]-          rejected =-            [ "",-              "req_",-              "other_" <> suffix,-              "req__" <> suffix,-              T.dropEnd 1 sampleText,-              sampleText <> "0",-              T.toUpper sampleText,-              replaceAt (T.length "req_" + 0) '8' sampleText,-              replaceAt (T.length "req_" + 10) 'd' sampleText,-              replaceAt (T.length "req_" + 13) 'c' sampleText-            ]-          patternValue = either (error . show) id (idDomainTextPattern contract)-      idDomainVersion contract `shouldBe` "keiro-dsl/id-domain/typeid-v7/1"-      idDomainSeparator contract `shouldBe` '_'-      idDomainSuffixLength contract `shouldBe` 26-      idDomainMaxLength contract `shouldBe` T.length sampleText-      forM_ accepted $ \value -> do-        validateIdDomainText contract value `shouldBe` Right ()-        matchesTextPattern patternValue value `shouldBe` True-      forM_ rejected $ \value -> do-        validateIdDomainText contract value `shouldSatisfy` isLeft-        matchesTextPattern patternValue value `shouldBe` False--    it "agrees for generated canonical and malformed domain values" $ property $ do-      let crockford = "0123456789abcdefghjkmnpqrstvwxyz"-          segment count = vectorOf count (elements crockford)-      leading <- elements "01234567"-      beforeVersion <- segment 9-      version <- elements "ef"-      beforeVariant <- segment 2-      variantDigit <- elements "89abrstv"-      afterVariant <- segment 12-      let value = T.pack ("req_" <> [leading] <> beforeVersion <> [version] <> beforeVariant <> [variantDigit] <> afterVariant)-          contract = typeIdV7Domain "req"-          patternValue = either (error . show) id (idDomainTextPattern contract)-          invalidValues = [T.toUpper value, "other_" <> T.drop 4 value, T.dropEnd 1 value, value <> "0"]-      pure $-        conjoin-          ( counterexample (T.unpack value) (validateIdDomainText contract value == Right () && matchesTextPattern patternValue value)-              : [counterexample (T.unpack invalid) (isLeft (validateIdDomainText contract invalid) && not (matchesTextPattern patternValue invalid)) | invalid <- invalidValues]-          )--    it "enforces the same contract before consumer binding conversion and explains its version" $ do-      v2Source <- readTestText "test/fixtures/nominal-scalars.keiro"-      let v3Text = T.replace "language keiro-dsl 2" "language keiro-dsl 3" v2Source-      parsed <- case parseSource "nominal-scalars-v3.keiro" v3Text of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      let service = checkedSource parsed-          spec = checkedSpec service-          modules = scaffoldServiceModules (defaultContext (spec.context)) service-          generatedText suffix = case [(.text) value | value <- modules, T.pack suffix `T.isSuffixOf` T.pack ((.path) value)] of-            [value] -> value-            values -> error ("expected one generated module ending in " <> suffix <> ", got " <> show (length values))-          codecModule = generatedText "NominalLedger/Codec.hs"-          projectionModule = generatedText "NominalProjections.hs"-          harnessModule = generatedText "NominalLedger/Harness.hs"-      validateService service `shouldBe` []-      codecModule `shouldSatisfy` T.isInfixOf "case validateIdDomainText (typeIdV7Domain \"ord\") input of"-      codecModule `shouldSatisfy` T.isInfixOf "Right () -> case KindID.parseText @\"ord\" input of"-      projectionModule `shouldSatisfy` T.isInfixOf "idDomainTextPattern (typeIdV7Domain \"ord\")"-      projectionModule `shouldSatisfy` T.isInfixOf "validateIdDomainText (typeIdV7Domain \"ord\") value"-      harnessModule `shouldSatisfy` T.isInfixOf "nominal ID binding preserves canonical representations: OrderId"-      harnessModule `shouldSatisfy` T.isInfixOf "nominal ID boundary rejects wrong-prefix and normalized text: OrderId"-      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligationsForService service)-      let orderIdBindings = [obligation | obligation <- obligations, (.mappedName) obligation == "OrderId", (.kind) obligation == BindingValue]-      map (.idDomainContract) orderIdBindings `shouldBe` [Just "keiro-dsl/id-domain/typeid-v7/1"]-      renderBindingObligations (spec.context) obligations-        `shouldSatisfy` T.isInfixOf "id-domain-contract: \"keiro-dsl/id-domain/typeid-v7/1\""--    it "reports adoption by boundary, invalidates snapshots, and preserves replay compatibility" $ do-      v2Text <- readTestText "test/fixtures/id-domain-migration-v3.keiro"-      let oldText = T.replace "language keiro-dsl 3" "language keiro-dsl 2" v2Text-      oldSource <- case parseSource "id-domain-migration-v2.keiro" oldText of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      newSource <- case parseSource "id-domain-migration-v3.keiro" v2Text of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      let oldService = checkedSource oldSource-          newService = checkedSource newSource-          changes = diffSources oldSource newSource-          findings = [kindOfChange change | change <- changes, changeCode change == IdDomainContractChanged]-      length findings `shouldBe` 1-      forM_ findings $ \finding -> do-        verdictFor PrivateHistoryRead (finding.vector) `shouldBe` VCompatible-        verdictFor OldBinaryReadNewEvents (finding.vector) `shouldBe` VCompatible-        verdictFor SnapshotHydration (finding.vector) `shouldBe` VAdvisory-        verdictFor PublicConsumer (finding.vector) `shouldBe` VBreaking-        verdictFor PersistedIdentity (finding.vector) `shouldBe` VCompatible-        verdictFor ConsumerBuild (finding.vector) `shouldBe` VAdvisory-        (.detail) finding `shouldSatisfy` T.isInfixOf "historical event replay retains its legacy decoder"-        remediationFor (finding.context) ((.code) finding)-          `shouldBe` RemedyDeploymentOrder RolloutProducerLast :| [RemedyStateCodecBump, RemedyRecompileConsumers, RemedyRunConformance]-      [(.detail) finding | change <- changes, changeCode change == SourceLanguageDeclarationChanged, let finding = kindOfChange change]-        `shouldSatisfy` all (T.isInfixOf "effective runtime semantics changed")-      idDomainIdentitiesForService oldService `shouldBe` []-      idDomainIdentitiesForService newService-        `shouldSatisfy` any (T.isInfixOf "contract=keiro-dsl/id-domain/typeid-v7/1")-      resolvedFold (ReplayImpact.replayImpactServices oldService newService) `shouldSatisfy` \case-        ReplayImpact.ReplayAffected impacts ->-          maybe False (.includeSnapshotStreams) (Map.lookup "OrderBook" impacts)-        ReplayImpact.ReplayNeutral -> False--    it "keeps the raw constructor outside the compiled public module surface" $-      withTempDirectory "keiro-dsl-id-domain-hidden-constructor" $ \out -> do-        sourceText <- readTestText "test/fixtures/id-domain-migration-v3.keiro"-        parsed <- case parseSource "id-domain-migration-v3.keiro" sourceText of-          Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-          Right value -> pure value-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            modules = scaffoldServiceModules ctx service-            attempt = out </> "Attempt.hs"-            ghcOutput = out </> ".ghc"-        result <- executeServiceScaffold out False "id-domain-migration-v3.keiro" ((.sourceLanguage) parsed) ctx service modules-        result `shouldSatisfy` isRight-        recordContents <- TIO.readFile (out </> recordFileName (spec.context))-        record <- case parseRecord recordContents of-          Nothing -> expectationFailure "generated ID-domain scaffold record did not parse" >> fail "unreachable"-          Just value -> pure value-        (.idDomains) record `shouldBe` idDomainIdentitiesForService service-        (.nominalEqualities) record-          `shouldSatisfy` any (T.isInfixOf "keiro-dsl/id-domain/typeid-v7/1")-        createDirectoryIfMissing True ghcOutput-        TIO.writeFile-          attempt-          ( T.unlines-              [ "module Attempt where",-                "import Generated.IdDomainMigration.Nominals (OrderId (..))",-                "bad :: OrderId",-                "bad = OrderId \"ord_LEGACY-NOT-TYPEID\""-              ]-          )-        keiroCorePackageId <- activeCabalPackageId "keiro-core"-        (exitCode, standardOutput, standardError) <--          readProcessWithExitCode-            "cabal"-            [ "exec",-              "--enable-tests",-              "--",-              "ghc",-              "-XGHC2024",-              "-XOverloadedStrings",-              "-fno-code",-              "-fforce-recomp",-              "-package-id",-              keiroCorePackageId,-              "-outputdir",-              ghcOutput,-              "-i" <> out,-              attempt-            ]-            ""-        exitCode `shouldSatisfy` (/= ExitSuccess)-        (standardOutput <> standardError) `shouldContain` "OrderId"--    it "emits one enforced nominal owner for a version-3 workspace" $ do-      manifest <- readTestText "test/fixtures/workspace-nominals/service.keiro-workspace"-      shared <- readTestText "test/fixtures/workspace-nominals/domain/shared.keiro"-      project <- readTestText "test/fixtures/workspace-nominals/domain/project.keiro"-      artifact <- readTestText "test/fixtures/workspace-nominals/domain/project-artifact.keiro"-      let v3 = T.replace "language keiro-dsl 2" "language keiro-dsl 3"-          source =-            memoryContentSource-              ( Map.fromList-                  [ ("service.keiro-workspace", manifest),-                    ("domain/shared.keiro", v3 shared),-                    ("domain/project.keiro", v3 project),-                    ("domain/project-artifact.keiro", v3 artifact)-                  ]-              )-      loaded <- loadWorkspace source "service.keiro-workspace"-      workspace <- case loaded of-        Left failure -> expectationFailure (show failure) >> fail "unreachable"-        Right value -> pure value-      plan <- case planWorkspaceScaffold "goldens" (workspaceContext workspace) workspace of-        Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-        Right value -> pure value-      let paths = map ((.path) . fst) ((.modules) plan)-      length (filter (== "Generated/WorkspaceNominalProof/Nominals.hs") paths) `shouldBe` 1-      length (filter (== "Generated/WorkspaceNominalProof/Nominals/Internal.hs") paths) `shouldBe` 1-      forM_ [(.text) value | (value, _) <- (.modules) plan, "/Domain.hs" `T.isSuffixOf` T.pack ((.path) value)] $ \domainText ->-        domainText `shouldSatisfy` (not . T.isInfixOf "ProjectId (..)")-      withTempDirectory "keiro-dsl-v3-workspace-record" $ \out -> do-        emitted <- executeWorkspaceScaffold out False plan-        emitted `shouldSatisfy` isRight-        recordContents <- TIO.readFile (out </> workspaceRecordFileName ((.service) workspace))-        record <- case parseWorkspaceRecord recordContents of-          Nothing -> expectationFailure "version-3 workspace record did not parse" >> fail "unreachable"-          Just value -> pure value-        (.idDomains) record `shouldBe` idDomainIdentitiesForService (plan.checkedService)-        (.nominalEqualities) record-          `shouldSatisfy` any (T.isInfixOf "keiro-dsl/id-domain/typeid-v7/1")--    it "emits an abstract public ID, an internal legacy seam, and exact equality" $ do-      v2Source <- readTestText "test/fixtures/aggregate-scalar-expressions-v2.keiro"-      let v3Source = T.replace "language keiro-dsl 2" "language keiro-dsl 3" v2Source-      parsed <- case parseSource "aggregate-scalar-expressions-v3.keiro" v3Source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      let service = checkedSource parsed-          spec = checkedSpec service-          modules = scaffoldServiceModules (defaultContext (spec.context)) service-          moduleAt path = case [value | value <- modules, value.path == path] of-            [value] -> pure value-            values -> expectationFailure ("expected one module at " <> path <> ", got " <> show (map (.path) values)) >> fail "unreachable"-      validateService service `shouldBe` []-      publicNominals <- moduleAt "Generated/AggregateScalarExpressions/Nominals.hs"-      internalNominals <- moduleAt "Generated/AggregateScalarExpressions/Nominals/Internal.hs"-      domainModule <- moduleAt "Generated/AggregateScalarExpressions/ScalarAccount/Domain.hs"-      codecModule <- moduleAt "Generated/AggregateScalarExpressions/ScalarAccount/Codec.hs"-      transducerModule <- moduleAt "Generated/AggregateScalarExpressions/ScalarAccount/Transducer.hs"-      (.text) publicNominals `shouldSatisfy` T.isInfixOf "parseRequestId"-      (.text) publicNominals `shouldSatisfy` T.isInfixOf "instance ExactFieldProjection RequestIdEqualityProjection"-      (.text) publicNominals `shouldSatisfy` T.isInfixOf "idDomainTextPattern (typeIdV7Domain \"req\")"-      (.text) publicNominals `shouldSatisfy` (not . T.isInfixOf "unsafeRequestIdFromLegacyText")-      (.text) publicNominals `shouldSatisfy` (not . T.isInfixOf "newtype RequestId")-      (.text) internalNominals `shouldSatisfy` T.isInfixOf "newtype RequestId = RequestId Text"-      (.text) internalNominals `shouldSatisfy` T.isInfixOf "unsafeRequestIdFromLegacyText"-      (.text) domainModule `shouldSatisfy` (not . T.isInfixOf "RequestId (..)")-      (.text) codecModule `shouldSatisfy` T.isInfixOf "unsafeRequestIdFromLegacyText <$>"-      (.text) transducerModule `shouldSatisfy` T.isInfixOf "case parseRequestId"-      firewallBreaches modules `shouldBe` []--  describe "scalar expressions" $ do-    it "parses, validates, and round-trips the authoritative stable scalar fixture" $ do-      source <- readTestText "test/fixtures/aggregate-scalar-expressions-v2.keiro"-      parsed <- case parseSource "aggregate-scalar-expressions-v2.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      validateSpec ((.spec) parsed) `shouldBe` []-      parseSource "round-trip.keiro" (renderSource parsed) `shouldBe` Right parsed-      case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) parsed)] of-        [aggregate] -> case (.transitions) aggregate of-          transition : holeTransition : [] -> do-            (.implementation) transition `shouldBe` GeneratedImplementation-            (.implementation) holeTransition `shouldBe` HoleImplementation-            let environment = expressionEnvironment ((.spec) parsed) aggregate transition-            case lookup "reserved" ((.writes) transition) >>= either (const Nothing) Just . resolveWriteExpr environment "reserved" of-              Just resolved -> do-                (.valueType) resolved `shouldBe` AggregateNatural-                show ((.node) resolved) `shouldContain` "TotalNaturalArithmetic"-              Nothing -> expectationFailure "reserved write did not resolve"-            let service = checkedSource parsed-                modules = scaffoldServiceModules (defaultContext (parsed.spec.context)) service-                transducer = generatedTextEndingIn "Transducer.hs" modules-                holes = holeTextEndingIn "Holes.hs" modules-                surface = aggregateFoldSurfaceForService service aggregate-                manifest = renderManifestForService "aggregate-scalar-expressions-v2.keiro" modules service-                readableTransducer = T.unwords (T.words transducer)-            aggregateFoldFingerprintForService service aggregate `shouldBe` "60f4f059f718b2ee2bca06360ea20221"-            T.lines surface-              `shouldBe` [ "semantic-contract:keiro-dsl/runtime-semantics/2",-                           "state:Open|terminal=false",-                           "state:Reviewed|terminal=false",-                           "state:Closed|terminal=true",-                           "reg:balance:Integer=0",-                           "reg:reserved:Natural=0",-                           "reg:capacity:Natural=5",-                           "reg:machine:Int=0",-                           "reg:label:Text=\"\"",-                           "reg:active:Bool=False",-                           "reg:mode:AccountMode=Normal",-                           "reg:requestId:RequestId=placeholder",-                           "reg:openedAt:Time=(UTCTime (fromGregorian 2026 1 1) (picosecondsToDiffTime 0))",-                           "reg:limits:Limits=initial",-                           "mapped-register:Limits|wire=4463db782a5b9924|canonical=scalar-expressions.Limits.v1|binding=ScalarExpressions.Bindings.limitsBinding|binding-version=1|initial=ScalarExpressions.Bindings.initialLimits",-                           "nominal-equality-use:nominal-equality|name=AccountMode|contract=keiro-dsl/nominal-equality/1|key=Text|domain=finite-text:normal,restricted|owner=generated",-                           "nominal-equality-use:nominal-equality|name=RequestId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:req:keiro-dsl/id-domain/typeid-v7/1|owner=generated",-                           "transition:live|Open|Adjust|implementation=generated|guard=cmd.balance + reg.balance >= -100 && reg.reserved + cmd.requested <= reg.capacity && cmd.observedAt >= reg.openedAt && cmd.limits.minimum >= reg.limits.minimum && cmd.active == false && cmd.mode == reg.mode && cmd.requestId == reg.requestId|writes=balance:=reg.balance + cmd.balance * 2;reserved:=reg.reserved + (cmd.requested - reg.capacity);machine:=-7;label:=\"adjusted\";active:=true;mode:=AccountMode.Restricted;requestId:=RequestId(\"req_01h455vb4pex5vsknk084sn02q\");openedAt:=\"2026-02-03T04:05:06Z\";limits:=cmd.limits|emits=Adjusted|outputs=Adjusted=generated-command-identity:Adjust[balance=balance:Integer,requested=requested:Natural,machine=machine:Int,label=label:Text,active=active:Bool,mode=mode:AccountMode,requestId=requestId:RequestId,observedAt=observedAt:Time,limits=limits:Limits]|goto=Reviewed",-                           "transition:live|Reviewed|Close|implementation=hole|guard=|writes=|emits=ClosedEvent|outputs=ClosedEvent=generated-command-identity:Close[balance=balance:Integer]|goto=Closed"-                         ]-            diffServices service service `shouldBe` []-            resolvedFold (ReplayImpact.replayImpactServices service service) `shouldBe` ReplayNeutral-            manifest `shouldSatisfy` (not . T.isInfixOf "Generated.AggregateScalarExpressions.ScalarAccount.Expressions")-            map (.path) modules `shouldSatisfy` all (not . T.isSuffixOf "Expressions.hs" . T.pack)-            map (.path) modules `shouldSatisfy` any (T.isSuffixOf "Transducer.hs" . T.pack)-            transducer `shouldSatisfy` T.isInfixOf "let commandLimitsMinimum = K.inpProj"-            transducer `shouldSatisfy` T.isInfixOf "registerLimitsMinimum = K.regProj"-            readableTransducer `shouldSatisfy` T.isInfixOf "B.requireGuard $ (((((d.balance .+ B.reg @\"balance\" .>= K.lit (-100 :: Integer) .&& B.reg @\"reserved\" .+ d.requested .<= B.reg @\"capacity\") .&& d.observedAt .>= B.reg @\"openedAt\") .&& commandLimitsMinimum .>= registerLimitsMinimum) .&& d.active .== K.lit False) .&& commandMode .== registerMode) .&& commandRequestId .== registerRequestId"-            transducer `shouldSatisfy` T.isInfixOf "B.slot @\"balance\" =: (B.reg @\"balance\" .+ d.balance .* K.lit (2 :: Integer))"-            transducer `shouldSatisfy` T.isInfixOf "B.slot @\"reserved\" =: (B.reg @\"reserved\" .+ (d.requested .- B.reg @\"capacity\"))"-            transducer `shouldSatisfy` (not . T.isInfixOf "K.PAnd")-            transducer `shouldSatisfy` (not . T.isInfixOf "K.tadd")-            transducer `shouldSatisfy` T.isInfixOf "scalarAccountPredicateVerifications"-            transducer `shouldSatisfy` T.isInfixOf "S.verifyPredicate predicate"-            transducer `shouldSatisfy` T.isInfixOf "B.emit wireAdjusted (AdjustedTermFields"-            transducer `shouldSatisfy` T.isInfixOf "balance = d.balance"-            transducer `shouldSatisfy` (not . T.isInfixOf "transition1OpenAdjustOutput1Adjusted")-            holes `shouldSatisfy` (not . T.isInfixOf "transition1OpenAdjustOutput1Adjusted")-            holes `shouldSatisfy` (not . T.isInfixOf "transition2ReviewedCloseOutput1ClosedEvent")-            holes `shouldSatisfy` T.isInfixOf "transition2ReviewedCloseHoleFoldVersion"-            holes `shouldSatisfy` (not . T.isInfixOf "scalarAccountTransducer")-            firewallBreaches modules `shouldBe` []-          _ -> expectationFailure "expected one generated and one Hole scalar transition"-        _ -> expectationFailure "expected one scalar aggregate"--    it "pins every readable operator, equal-precedence child position, and bare Boolean guard" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context readable-renderer",-                "enum RenderStatus { Ready=ready Waiting=waiting }",-                "aggregate Renderer",-                "  regs",-                "    total Integer = 0",-                "    leftNested Integer = 0",-                "    product Integer = 1",-                "    status RenderStatus = Ready",-                "  states Open Closed!",-                "  command Evaluate { left:Integer right:Integer third:Integer status:RenderStatus }",-                "  event Evaluated = fields(Evaluate)",-                "  Open -- Evaluate -->",-                "    guard ((cmd.left < cmd.right || cmd.left <= cmd.right) || (cmd.left > cmd.right || cmd.left >= cmd.right))",-                "      && (cmd.left == cmd.right && cmd.left != cmd.third)",-                "      && cmd.status == RenderStatus.Waiting",-                "    write total := reg.total + (cmd.left - cmd.right)",-                "    write leftNested := (reg.leftNested + cmd.left) - cmd.right",-                "    write product := cmd.left * (cmd.right * cmd.third)",-                "    write status := RenderStatus.Ready",-                "    emit Evaluated",-                "    goto Closed",-                "aggregate BooleanRenderer",-                "  regs",-                "    enabled Bool = False",-                "  states Open Closed!",-                "  command Enable { enabled:Bool }",-                "  event Enabled = fields(Enable)",-                "  Open -- Enable -->",-                "    guard cmd.enabled",-                "    write enabled := cmd.enabled",-                "    emit Enabled",-                "    goto Closed"-              ]-      spec <- parseInlineSpec "<readable-renderer>" source-      errorCodes spec `shouldBe` []-      let modules = scaffoldModules (defaultContext (spec.context)) spec-          moduleAt suffix = case [(.text) value | value <- modules, T.pack suffix `T.isSuffixOf` T.pack ((.path) value)] of-            [value] -> pure value-            values -> expectationFailure ("expected one generated module ending in " <> suffix <> ", got " <> show (length values)) >> fail "unreachable"-      renderer <- moduleAt "/Renderer/Transducer.hs"-      booleanRenderer <- moduleAt "/BooleanRenderer/Transducer.hs"-      let normalizedRenderer = T.unwords (T.words renderer)-          normalizedBooleanRenderer = T.unwords (T.words booleanRenderer)-      renderer-        `shouldSatisfy` T.isInfixOf "import Keiki.Core (HsPred, SymTransducer, (.*), (.+), (.-), (.==), (./=), (.<), (.<=), (.>), (.>=), (.&&), (.||))"-      normalizedRenderer-        `shouldSatisfy` T.isInfixOf "(d.left .< d.right .|| d.left .<= d.right) .|| d.left .> d.right .|| d.left .>= d.right"-      normalizedRenderer-        `shouldSatisfy` T.isInfixOf ".&& d.left .== d.right .&& d.left ./= d.third"-      normalizedRenderer-        `shouldSatisfy` T.isInfixOf ".&& commandStatus .== K.lit (\"waiting\" :: Text)"-      renderer-        `shouldSatisfy` T.isInfixOf "B.slot @\"total\" =: (B.reg @\"total\" .+ (d.left .- d.right))"-      renderer-        `shouldSatisfy` T.isInfixOf "B.slot @\"leftNested\" =: (B.reg @\"leftNested\" .+ d.left .- d.right)"-      renderer-        `shouldSatisfy` T.isInfixOf "B.slot @\"product\" =: d.left .* (d.right .* d.third)"-      normalizedBooleanRenderer `shouldSatisfy` T.isInfixOf "B.requireGuard $ d.enabled .== K.lit True"-      firewallBreaches modules `shouldBe` []--    it "renders resolved command selectors in scalar and projected expressions" $ do-      source <- readTestText "test/fixtures/aggregate-scalar-expressions-v2.keiro"-      let aliasedSource =-            T.replace "active:Bool" "active haskell commandActive:Bool"-              . T.replace "mode:AccountMode" "mode haskell commandMode:AccountMode"-              . T.replace "requestId:RequestId" "requestId haskell commandRequestId:RequestId"-              . T.replace "limits:Limits" "limits haskell commandLimits:Limits"-              $ source-      service <- checkedServiceFromText "aggregate-scalar-expression-aliases.keiro" aliasedSource-      let spec = checkedSpec service-          transducer = generatedTextEndingIn "Transducer.hs" (scaffoldServiceModules (defaultContext (spec.context)) service)-      validateService service `shouldBe` []-      transducer `shouldSatisfy` T.isInfixOf "d.commandActive"-      transducer `shouldSatisfy` T.isInfixOf "d.commandLimits"-      transducer `shouldSatisfy` T.isInfixOf "(#commandMode :: K.Index"-      transducer `shouldSatisfy` T.isInfixOf "(#commandRequestId :: K.Index"-      transducer `shouldSatisfy` T.isInfixOf "(#commandLimits :: K.Index"-      transducer `shouldSatisfy` (not . T.isInfixOf "d.active")-      transducer `shouldSatisfy` (not . T.isInfixOf "inCtorAdjust (#mode :: K.Index")-      transducer `shouldSatisfy` (not . T.isInfixOf "inCtorAdjust (#requestId :: K.Index")-      transducer `shouldSatisfy` (not . T.isInfixOf "inCtorAdjust (#limits :: K.Index")--    it "suffixes normalized projection-alias collisions deterministically" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context projection-alias-collision",-                "mapped structural record AliasCollision {",-                "  haskell package=keiro-dsl module=Renderer.Domain type=AliasCollision",-                "  binding = \"Renderer.Bindings.aliasCollisionBinding\"",-                "  binding-version = \"1\"",-                "  canonical-type = \"renderer.AliasCollision.v1\"",-                "  fixtures = \"Renderer.Bindings.aliasCollisionCases\"",-                "  initial = \"Renderer.Bindings.initialAliasCollision\"",-                "  wire object constructor=AliasCollision unknown-fields=reject {",-                "    dash as \"foo-bar\" : Integer required",-                "    underscore as \"foo_bar\" : Integer required",-                "  }",-                "}",-                "aggregate AliasRenderer",-                "  regs",-                "    values AliasCollision = initial",-                "  states Open Closed!",-                "  command Compare { values:AliasCollision }",-                "  event Compared = fields(Compare)",-                "  Open -- Compare -->",-                "    guard cmd.values.dash == reg.values.dash",-                "      && cmd.values.underscore == reg.values.underscore",-                "    emit Compared",-                "    goto Closed"-              ]-      spec <- parseInlineSpec "<projection-alias-collision>" source-      errorCodes spec `shouldBe` []-      let transducer = generatedTextEndingIn "Transducer.hs" (scaffoldModules (defaultContext (spec.context)) spec)-      transducer `shouldSatisfy` T.isInfixOf "let commandValuesFooBar = K.inpProj"-      transducer `shouldSatisfy` T.isInfixOf "registerValuesFooBar = K.regProj"-      transducer `shouldSatisfy` T.isInfixOf "commandValuesFooBar2 = K.inpProj"-      transducer `shouldSatisfy` T.isInfixOf "registerValuesFooBar2 = K.regProj"--    it "keeps evolution identity independent of module layout but sensitive to checked behavior" $ do-      source <- readTestText "test/fixtures/aggregate-scalar-expressions-v2.keiro"-      original <- case parseSource "aggregate-scalar-expressions-v2.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      changed <- case parseSource "aggregate-scalar-expressions-changed.keiro" (T.replace "cmd.active == false" "cmd.active == true" source) of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      case ( [aggregate | NAggregate aggregate <- (.nodes) ((.spec) original)],-             [aggregate | NAggregate aggregate <- (.nodes) ((.spec) changed)]-           ) of-        ([originalAggregate], [changedAggregate]) -> do-          let service = checkedSource original-              changedService = checkedSource changed-              prefixed = defaultContext (original.spec.context)-              collocated = prefixed {moduleRoot = "Acme", placement = CollocatedLeaf}-              prefixedModules = scaffoldServiceModules prefixed service-              collocatedModules = scaffoldServiceModules collocated service-              originalSurface = aggregateFoldSurfaceForService service originalAggregate-              originalFingerprint = aggregateFoldFingerprintForService service originalAggregate-          map (.path) prefixedModules `shouldNotBe` map (.path) collocatedModules-          sum (map (T.length . (.text)) prefixedModules) `shouldSatisfy` (> 0)-          sum (map (T.length . (.text)) collocatedModules) `shouldSatisfy` (> 0)-          aggregateFoldSurfaceForService service originalAggregate `shouldBe` originalSurface-          aggregateFoldFingerprintForService service originalAggregate `shouldBe` originalFingerprint-          aggregateFoldSurfaceForService changedService changedAggregate `shouldNotBe` originalSurface-          aggregateFoldFingerprintForService changedService changedAggregate `shouldNotBe` originalFingerprint-        found -> expectationFailure ("expected one aggregate before and after behavior mutation, got " <> show (length (fst found), length (snd found)))--    it "rejects cross-command fields(Command) output before scaffolding" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context output-command-mismatch",-                "aggregate Account",-                "  regs",-                "  states Open Closed!",-                "  command OpenAccount { accountId:Text }",-                "  command CloseAccount { accountId:Text }",-                "  event AccountOpened = fields(OpenAccount)",-                "  Open -- CloseAccount --> emit AccountOpened ; goto Closed"-              ]-      spec <- parseInlineSpec "<output-command-mismatch>" source-      errorCodes spec `shouldContain` [EventOutputCommandMismatch]-      case [aggregate | NAggregate aggregate <- (.nodes) spec] of-        [aggregate] -> case (.transitions) aggregate of-          [transition] ->-            eventOutputMapping spec aggregate transition 1 "AccountOpened"-              `shouldBe` Left (OutputCommandMismatch "OpenAccount" "CloseAccount" "AccountOpened")-          _ -> expectationFailure "expected one transition"-        _ -> expectationFailure "expected one aggregate"--    it "rejects Int arithmetic and mixed numeric operands before scaffolding" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context scalar-errors",-                "aggregate Counter",-                "  regs",-                "    machine Int = 0",-                "    exact Integer = 0",-                "  states Open Closed!",-                "  command Add { machine:Int exact:Integer }",-                "  event Added = fields(Add)",-                "  Open -- Add -->",-                "    guard cmd.machine + 1 >= 0 && cmd.exact == cmd.machine",-                "    emit Added",-                "    goto Closed"-              ]-      spec <- parseInlineSpec "<scalar-errors>" source-      errorCodes spec `shouldContain` [AggregateExpressionOperatorUnsupported, AggregateExpressionOperandTypeMismatch]--    it "rejects nominal type confusion and unqualified enum values at source checking" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context nominal-type-confusion",-                "id OrderId prefix=ord",-                "id UserId prefix=usr",-                "enum OrderStatus { Draft=draft Submitted=submitted }",-                "enum UserStatus { Active=active Disabled=disabled }",-                "aggregate Account",-                "  regs",-                "    orderId OrderId = placeholder",-                "    status OrderStatus = Draft",-                "  states Open Closed!",-                "  command Compare { orderId:OrderId userId:UserId status:OrderStatus userStatus:UserStatus label:Text }",-                "  event Compared = fields(Compare)",-                "  Open -- Compare -->",-                "    guard cmd.orderId == cmd.userId",-                "      && cmd.status == cmd.userStatus",-                "      && cmd.orderId == cmd.label",-                "      && cmd.status == Draft",-                "    emit Compared",-                "    goto Closed"-              ]-      spec <- parseInlineSpec "<nominal-type-confusion>" source-      let diagnostics = validateSpec spec-      length [() | diagnostic <- diagnostics, (.code) diagnostic == AggregateExpressionOperandTypeMismatch]-        `shouldBe` 3-      errorCodes spec `shouldContain` [AggregateExpressionRootUnknown]-      T.unlines (map (.message) diagnostics) `shouldSatisfy` T.isInfixOf "qualify"--    it "rejects machine-Int arithmetic at both platform bounds" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context scalar-int-bounds",-                "aggregate Counter",-                "  regs",-                "    machine Int = 0",-                "  states Open Closed!",-                "  command Set { machine:Int }",-                "  event SetEvent = fields(Set)",-                "  Open -- Set -->",-                "    guard cmd.machine + 1 >= " <> T.pack (show (minBound :: Int)),-                "      && cmd.machine - 1 <= " <> T.pack (show (maxBound :: Int)),-                "    emit SetEvent",-                "    goto Closed"-              ]-      spec <- parseInlineSpec "<scalar-int-bounds>" source-      length [() | diagnostic <- validateSpec spec, (.code) diagnostic == AggregateExpressionOperatorUnsupported]-        `shouldBe` 2--    it "rejects predicate-valued Bool writes that Keiki cannot represent as scalar terms" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context scalar-bool-write",-                "aggregate Flag",-                "  regs",-                "    active Bool = False",-                "  states Open Closed!",-                "  command Set { active:Bool }",-                "  event SetEvent = fields(Set)",-                "  Open -- Set -->",-                "    write active := cmd.active == true",-                "    emit SetEvent",-                "    goto Closed"-              ]-      spec <- parseInlineSpec "<scalar-bool-write>" source-      errorCodes spec `shouldContain` [AggregateExpressionOperatorUnsupported]--    it "requires explicit roots for a same-named register and command field" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context scalar-ambiguity",-                "aggregate Counter",-                "  regs",-                "    amount Integer = 0",-                "  states Open Closed!",-                "  command Set { amount:Integer }",-                "  event SetEvent = fields(Set)",-                "  Open -- Set -->",-                "    guard amount == 0",-                "    emit SetEvent",-                "    goto Closed"-              ]-      spec <- parseInlineSpec "<scalar-ambiguity>" source-      errorCodes spec `shouldContain` [AggregateExpressionRootAmbiguous]--    it "enforces exclusive Hole ownership and preserves its canonical spelling" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context scalar-hole",-                "aggregate Counter",-                "  regs",-                "    amount Integer = 0",-                "  states Open Closed!",-                "  command Set { amount:Integer }",-                "  event SetEvent = fields(Set)",-                "  Open -- Set -->",-                "    implementation hole",-                "    guard cmd.amount >= 0",-                "    emit SetEvent",-                "    goto Closed"-              ]-      parsed <- case parseSource "<scalar-hole>" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      errorCodes ((.spec) parsed) `shouldContain` [AggregateTransitionOwnershipConflict]-      renderSource parsed `shouldSatisfy` T.isInfixOf "implementation hole"--    it "generates a stable per-transition Hole boundary and fold token" $ do-      let source =-            T.unlines-              [ "language keiro-dsl 2",-                "context scalar-hole",-                "aggregate Counter",-                "  regs",-                "    amount Integer = 0",-                "  states Open Closed!",-                "  command Set { amount:Integer }",-                "  event SetEvent = fields(Set)",-                "  Open -- Set -->",-                "    implementation hole",-                "    emit SetEvent",-                "    goto Closed"-              ]-      spec <- parseInlineSpec "<scalar-hole-valid>" source-      aggregate <- case [value | NAggregate value <- (.nodes) spec] of-        [value] -> pure value-        _ -> expectationFailure "expected one Hole aggregate" >> fail "unreachable"-      let modules = scaffoldAggregate (defaultContext (spec.context)) spec aggregate-          transducer = generatedTextEndingIn "Transducer.hs" modules-          holes = holeTextEndingIn "Holes.hs" modules-      errorCodes spec `shouldBe` []-      map (.path) modules `shouldSatisfy` all (not . T.isSuffixOf "Expressions.hs" . T.pack)-      transducer `shouldSatisfy` T.isInfixOf "Holes.transition1OpenSetHole d"-      transducer `shouldSatisfy` T.isInfixOf "foldToken Holes.transition1OpenSetHoleFoldVersion"-      holes `shouldSatisfy` T.isInfixOf "transition1OpenSetHole _d = B.requireGuard K.PTop"-      holes `shouldSatisfy` T.isInfixOf "transition1OpenSetHoleFoldVersion = FoldVersion"-      holes `shouldSatisfy` (not . T.isInfixOf "counterTransducer")--    it "pins v1 and collection rejection at their stable boundaries" $ do-      v1Source <- readTestText "test/fixtures/aggregate-scalar-expressions-v1-rejects.keiro"-      case parseSource "v1.keiro" v1Source of-        Left (SourceLanguageFailure diagnostic) -> (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion-        other -> expectationFailure ("expected v1 source-language refusal, got " <> show other)-      collectionSource <- readTestText "test/fixtures/aggregate-collection-expressions-v2-rejects.keiro"-      case parseSource "collections.keiro" collectionSource of-        Left failure -> renderParseFailure failure `shouldSatisfy` T.isInfixOf "CollectionExpressionUnsupported"-        Right _ -> expectationFailure "collection syntax unexpectedly parsed"--    it "keeps arithmetic operands intact when complementing a scalar comparison" $ do-      let left = EAdd noLoc (EPath noLoc CommandRoot ["balance"]) (ELiteral noLoc (LiteralIntegral 2))-          right = ESubtract noLoc (EPath noLoc RegisterRoot ["balance"]) (ELiteral noLoc (LiteralIntegral 3))-          predicate = ECmp OpLt left right-      complementExpr predicate `shouldBe` ECmp OpGe left right-      complementExpr (complementExpr predicate) `shouldBe` predicate--    it "keeps the committed scalar-expression conformance tree fresh" $ do-      modules <- scaffoldFixture "test/fixtures/aggregate-scalar-expressions-v2.keiro"-      forM_ [generatedModule | generatedModule <- modules, (.kind) generatedModule == Generated] $ \generatedModule -> do-        committed <- readTestText ("test/conformance-scalar-expressions/" <> (.path) generatedModule)-        normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) generatedModule)--  describe "behavior obligations" $ do-    describe "record migration byte contracts" $ do-      it "joins every source-stable behavior origin to one exact source position and freezes behavior-obligations JSON bytes" $ do-        source <- readTestText "test/fixtures/behavior-complete.keiro"-        document <- case parseSourceDocument "test/fixtures/behavior-complete.keiro" source of-          Left failure -> expectationFailure (show failure) >> fail "unreachable"-          Right value -> pure value-        let ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = document-            spec = checkedSpec (checkedSource parsedSource)-        requirements <- either (\errors -> expectationFailure (show errors) >> fail "unreachable") pure (Behavior.deriveBehaviorRequirements spec)-        entries <- either (\errors -> expectationFailure (show errors) >> fail "unreachable") pure (BehaviorSource.planBehaviorSourceMap requirements sourceIndex)-        map (.key) entries `shouldBe` map (.key) requirements-        entries `shouldSatisfy` all ((== "test/fixtures/behavior-complete.keiro") . (.file))-        entries `shouldSatisfy` all ((>= 1) . (.line))-        entries `shouldSatisfy` all ((>= 1) . (.column))-        let exactRequirements = BehaviorSource.attachBehaviorSourceLocations entries requirements-            exactJson =-              Behavior.encodeBehaviorObligationsJson-                (Behavior.BehaviorObligationsReport "test/fixtures/behavior-complete.keiro" Nothing exactRequirements)-            exactText =-              Behavior.renderBehaviorObligationsText-                (Behavior.BehaviorObligationsReport "test/fixtures/behavior-complete.keiro" Nothing exactRequirements)-            exactBytes = TextEncoding.encodeUtf8 exactJson-        assertMatchesByteGolden "test/fixtures/record-migration/behavior-obligations.exact.json.golden" exactBytes-        case Aeson.eitherDecodeStrict' exactBytes of-          Left failure -> expectationFailure ("behavior-obligations JSON did not decode: " <> failure)-          Right value -> do-            jsonField "schema" value `shouldBe` Just (Aeson.String "keiro-dsl/behavior-obligations/1")-            case jsonField "requirements" value of-              Just (Aeson.Array encodedRequirements) -> length encodedRequirements `shouldBe` length requirements-              other -> expectationFailure ("expected behavior requirements array, got " <> show other)-        exactJson `shouldSatisfy` T.isInfixOf "\"quality\":\"exact\""-        exactJson `shouldSatisfy` T.isInfixOf "\"column\":"-        exactJson `shouldSatisfy` T.isInfixOf "\"file\":\"test/fixtures/behavior-complete.keiro\""-        exactText `shouldSatisfy` T.isInfixOf "test/fixtures/behavior-complete.keiro:"-        exactText `shouldSatisfy` T.isInfixOf "[location-quality=exact]"-        [(.origin) requirement | requirement <- requirements, (.kind) requirement == Behavior.RequiredRejection]-          `shouldSatisfy` all (\case Behavior.RejectionRequirementOrigin "Journey" _ -> True; _ -> False)--      it "freezes representative single-file scaffold ledger bytes and parses the golden" $ do-        (singleRecord, _) <- representativeRecordMigrationContracts-        let rendered = renderRecord singleRecord-            renderedBytes = TextEncoding.encodeUtf8 rendered-        assertMatchesByteGolden "test/fixtures/record-migration/single-file-scaffold-record.ledger.golden" renderedBytes-        golden <- readTestText "test/fixtures/record-migration/single-file-scaffold-record.ledger.golden"-        parseRecord golden `shouldBe` Just singleRecord--      it "freezes representative workspace scaffold ledger bytes and parses the golden" $ do-        (_, workspaceRecord) <- representativeRecordMigrationContracts-        let rendered = renderWorkspaceRecord workspaceRecord-            renderedBytes = TextEncoding.encodeUtf8 rendered-        assertMatchesByteGolden "test/fixtures/record-migration/workspace-scaffold-record.ledger.golden" renderedBytes-        golden <- readTestText "test/fixtures/record-migration/workspace-scaffold-record.ledger.golden"-        parseWorkspaceRecord golden `shouldBe` Just workspaceRecord--    it "refuses line-only, missing, and duplicate behavior source anchors before writes" $-      withTempDirectory "keiro-dsl-source-anchor-refusal" $ \out -> do-        baselineTree <- treeSnapshot out-        spec <- specOf "test/fixtures/behavior-complete.keiro"-        requirements <- either (\errors -> expectationFailure (show errors) >> fail "unreachable") pure (Behavior.deriveBehaviorRequirements spec)-        compatibility <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (compatibilitySemanticSourceIndex "behavior-complete.keiro" spec)-        let failureCodes result = case result of-              Left failures -> map (.code) failures-              Right _ -> []-        failureCodes (BehaviorSource.planBehaviorSourceMap requirements compatibility)-          `shouldSatisfy` all (== BehaviorSource.BehaviorSourceAnchorInexact)-        failureCodes (BehaviorSource.planBehaviorSourceMap requirements emptySemanticSourceIndex)-          `shouldSatisfy` all (== BehaviorSource.BehaviorSourceAnchorMissing)-        case BehaviorSource.planBehaviorSourceMap requirements emptySemanticSourceIndex of-          Left (failure : _) -> do-            let diagnostics = planningRefusalDiagnostics [BehaviorSourceRefusal [failure]]-            map (.code) diagnostics `shouldBe` [BehaviorSourceAnchorMissing]-            map (.message) diagnostics `shouldSatisfy` all (T.isInfixOf "behavior-v1-")-            map (.message) diagnostics `shouldSatisfy` all (T.isInfixOf "Journey:")-            map (.message) diagnostics `shouldSatisfy` all (T.isInfixOf "subject=Aggregate")-          result -> expectationFailure ("expected missing-anchor diagnostics, got " <> show result)-        case requirements of-          first : _ ->-            failureCodes (BehaviorSource.planBehaviorSourceMap (first : requirements) compatibility)-              `shouldContain` [BehaviorSource.BehaviorSourceAnchorCollision]-          [] -> expectationFailure "behavior fixture unexpectedly has no requirements"-        treeSnapshot out `shouldReturn` baselineTree--    it "plans one exact context source map and removes line-derived contract and witness bytes" $ do-      source <- readTestText "test/fixtures/behavior-complete.keiro"-      document <- case parseSourceDocument "test/fixtures/behavior-complete.keiro" source of-        Left failure -> expectationFailure (show failure) >> fail "unreachable"-        Right value -> pure value-      let ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = document-          service = checkedSource parsedSource-          ctx = defaultContext ((checkedSpec service).context)-      modules <- either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure (planIndexedServiceScaffold sourceIndex ctx service)-      let sourceMaps = [(.text) value | value <- modules, T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack ((.path) value))]-          contracts = [(.text) value | value <- modules, T.isSuffixOf "/BehaviorContract.hs" (T.pack ((.path) value))]-          witnesses = [(.text) value | value <- modules, T.isSuffixOf "/BehaviorHoles.hs" (T.pack ((.path) value))]-      case sourceMaps of-        [sourceMapText] -> sourceMapText `shouldSatisfy` T.isInfixOf "test/fixtures/behavior-complete.keiro"-        values -> expectationFailure ("expected one behavior source map, got " <> show (length values))-      contracts `shouldSatisfy` all (T.isInfixOf ".BehaviorSourceMap qualified as BehaviorSourceMap")-      contracts `shouldSatisfy` all (not . T.isInfixOf "requirementLine")-      contracts `shouldSatisfy` all (not . T.isInfixOf "spec line")-      witnesses `shouldSatisfy` all (not . T.isInfixOf "spec line")-      compatibility <--        either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure $-          compatibilitySemanticSourceIndex "<semantic-only>" (checkedSpec service)-      requirements <--        either (\errors -> expectationFailure (show errors) >> fail "unreachable") pure $-          Behavior.deriveBehaviorRequirements (checkedSpec service)-      case BehaviorSource.planBehaviorSourceMap requirements compatibility of-        Left failures ->-          failures `shouldSatisfy` all ((== BehaviorSource.BehaviorSourceAnchorInexact) . (.code))-        Right _ -> expectationFailure "compatibility line-only provenance fabricated exact behavior columns"--    it "omits the context source map when no behavior contract can import it" $ do-      spec <- parseInlineSpec "<no-behavior>" "language keiro-dsl 4\ncontext no-behavior\n"-      modules <- either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure (planTestScaffold (defaultContext "no-behavior") spec)-      map (.path) modules `shouldSatisfy` all (not . T.isSuffixOf "BehaviorSourceMap.hs" . T.pack)-      map (.path) modules `shouldSatisfy` all (not . T.isSuffixOf "BehaviorContract.hs" . T.pack)--    it "uses one source-wide layout and excludes replay-only initial edges from live harness probes" $ do-      spec <--        parseInlineSpec "<transition-layout>" $-          T.unlines-            [ "language keiro-dsl 4",-              "context transition-layout",-              "aggregate Journey",-              "  regs",-              "  states Empty Active",-              "  command Start { current:Bool }",-              "  command Legacy { current:Bool }",-              "  event Started = fields(Start)",-              "  event LegacyStarted = fields(Legacy)",-              "  Empty -- Start --> guard cmd.current == true ; emit Started ; goto Active",-              "  Active -- Start --> emit Started ; goto Active",-              "  replay-only Empty -- Start --> guard cmd.current == false ; emit Started ; goto Active",-              "  Active -- Legacy --> emit LegacyStarted ; goto Active",-              "  replay-only Empty -- Legacy --> emit LegacyStarted ; goto Active"-            ]-      aggregate <- case [value | NAggregate value <- (.nodes) spec] of-        [value] -> pure value-        _ -> expectationFailure "expected one transition-layout aggregate" >> fail "unreachable"-      let ctx = defaultContext (spec.context)-          modules = scaffoldAggregate ctx spec aggregate <> harnessFor ctx spec aggregate-          transducer = generatedTextEndingIn "Transducer.hs" modules-          harness = generatedTextEndingIn "Harness.hs" modules-          contract = generatedTextEndingIn "BehaviorContract.hs" modules-      T.count "B.from JourneyEmpty do" transducer `shouldBe` 1-      transducer `shouldSatisfy` T.isInfixOf "transition3EmptyStart"-      transducer `shouldSatisfy` T.isInfixOf "transition5EmptyLegacy"-      T.count "acceptStart :: Bool" harness `shouldBe` 1-      harness `shouldSatisfy` (not . T.isInfixOf "acceptLegacy")-      contract `shouldSatisfy` T.isInfixOf "K.EdgeRef JourneyEmpty 1"-      contract `shouldSatisfy` T.isInfixOf "K.EdgeRef JourneyEmpty 2"--    it "refuses duplicate live initial harness helpers with both source locations" $ do-      spec <--        parseInlineSpec "<initial-helper-collision>" $-          T.unlines-            [ "language keiro-dsl 4",-              "context helper-collision",-              "aggregate Journey",-              "  regs",-              "  states Empty Active",-              "  command Start { current:Bool }",-              "  event Started = fields(Start)",-              "  Empty -- Start --> guard cmd.current == true ; emit Started ; goto Active",-              "  Empty -- Start --> guard cmd.current == false ; emit Started ; goto Active"-            ]-      let collisions = [diagnostic | diagnostic <- validateSpec spec, (.code) diagnostic == GeneratedOccurrenceCollision]-      map (.line) collisions `shouldBe` [9, 9]-      collisions `shouldSatisfy` all (elem (8, "'Start' also normalizes here") . (.relatedLocations))--    it "inventories generated harness sample constants before rendering" $ do-      service <--        checkedServiceFromText-          "<sample-helper-collision>"-          ( T.unlines-              [ "language keiro-dsl 4",-                "context helper-collision",-                "id ObservedAt prefix=obs",-                "aggregate Journey",-                "  regs",-                "  states Empty",-                "  command Start {",-                "    request:ObservedAt",-                "    observedAt:Time",-                "  }"-              ]-          )-      let collisions = [diagnostic | diagnostic <- validateService service, (.code) diagnostic == GeneratedOccurrenceCollision]-      map (.line) collisions `shouldBe` [9]-      collisions `shouldSatisfy` all (elem (3, "'ObservedAt' also normalizes here") . (.relatedLocations))--    it "inventories every live-reachable cell, guarded edge, terminal rejection, and replay edge" $ do-      spec <- specOf "test/fixtures/behavior-complete.keiro"-      requirements <- either (\errors -> expectationFailure (show errors) >> pure []) pure (Behavior.deriveBehaviorRequirements spec)-      length requirements `shouldBe` 19-      length [() | requirement <- requirements, (.kind) requirement == Behavior.LiveTransition] `shouldBe` 5-      length [() | requirement <- requirements, (.kind) requirement == Behavior.RequiredRejection] `shouldBe` 11-      length [() | requirement <- requirements, (.kind) requirement == Behavior.ReplayTransition] `shouldBe` 3-      [(.source) requirement | requirement <- requirements, (.kind) requirement == Behavior.RequiredRejection]-        `shouldContain` ["Active", "Closed"]-      length [() | requirement <- requirements, (.guardCoverage) requirement == Behavior.GuardTotal] `shouldBe` 3-      length [() | requirement <- requirements, (.guardCoverage) requirement == Behavior.GuardUnknown] `shouldBe` 2-      let report = Behavior.BehaviorObligationsReport "behavior-complete.keiro" Nothing requirements-          encoded = Behavior.encodeBehaviorObligationsJson report-          rendered = Behavior.renderBehaviorObligationsText report-      encoded `shouldSatisfy` T.isInfixOf "\"schema\":\"keiro-dsl/behavior-obligations/1\""-      encoded `shouldSatisfy` T.isInfixOf "\"source\":\"Closed\""-      encoded `shouldSatisfy` T.isInfixOf "\"kind\":\"replay-transition\""-      encoded `shouldSatisfy` T.isInfixOf "\"quality\":\"line-only\""-      rendered `shouldSatisfy` T.isInfixOf "[location-quality=line-only]"-      encoded `shouldSatisfy` (not . T.isInfixOf "\"filled\"")-      encoded `shouldSatisfy` (not . T.isInfixOf "\"missing\"")--    it "keeps semantic keys stable across line movement and canonical pretty printing" $ do-      source <- readTestText "test/fixtures/behavior-complete.keiro"-      parsed <- case parseSource "behavior-complete.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      let original = (.spec) parsed-      moved <- parseInlineSpec "behavior-complete-moved.keiro" ("# line movement must not rename witnesses\n\n" <> source)-      pretty <- parseInlineSpec "behavior-complete-pretty.keiro" (renderSource parsed)-      let keys spec = fmap (map (.key)) (Behavior.deriveBehaviorRequirements spec)-      keys moved `shouldBe` keys original-      keys pretty `shouldBe` keys original--    it "generates direct fields(Command) output and separate create-once pending witnesses" $ do-      service <- checkedServiceOf "test/fixtures/behavior-complete.keiro"-      let spec = checkedSpec service-      aggregate <- case [value | NAggregate value <- (.nodes) spec] of-        [value] -> pure value-        _ -> expectationFailure "expected one behavior-complete aggregate" >> fail "unreachable"-      let ctx = defaultContext (spec.context)-          modules = scaffoldAggregate ctx spec aggregate-          harness = generatedTextEndingIn "Harness.hs" (harnessForService ctx service aggregate)-          transducer = generatedTextEndingIn "Transducer.hs" modules-          codec = generatedTextEndingIn "Codec.hs" modules-          contract = generatedTextEndingIn "BehaviorContract.hs" modules-          projection = generatedTextEndingIn "Projection.hs" modules-          behaviorHoles = case [(.text) value | value <- modules, T.isSuffixOf "BehaviorHoles.hs" (T.pack ((.path) value))] of-            [value] -> value-            values -> error ("expected one BehaviorHoles module, got " <> show (length values))-          ordinaryHoles = [value | value <- modules, T.isSuffixOf "/Holes.hs" (T.pack ((.path) value)), not (T.isSuffixOf "BehaviorHoles.hs" (T.pack ((.path) value)))]-      transducer `shouldSatisfy` T.isInfixOf "requestId = d.requestId"-      transducer `shouldSatisfy` T.isInfixOf "observedAt = d.observedAt"-      transducer `shouldSatisfy` T.isInfixOf "amount = d.amount"-      transducer `shouldSatisfy` T.isInfixOf "details = d.details"-      codec `shouldSatisfy` T.isInfixOf "display_label"-      codec `shouldSatisfy` T.isInfixOf "optional_note"-      transducer `shouldSatisfy` (not . T.isInfixOf "Output")-      ordinaryHoles `shouldBe` []-      obsoleteGeneratedOutputHooks spec `shouldContain` [("Journey", "transition1EmptyStartOutput1Started")]-      T.count "B.from JourneyEmpty do" transducer `shouldBe` 1-      transducer `shouldSatisfy` T.isInfixOf "verifyTransition \"transition3EmptyStart\" GeneratedOwned JourneyEmpty 1"-      transducer `shouldSatisfy` T.isInfixOf "verifyTransition \"transition5EmptyLegacyStart\" GeneratedOwned JourneyEmpty 2"-      T.count "acceptStart :: Bool" harness `shouldBe` 1-      harness `shouldSatisfy` (not . T.isInfixOf "acceptLegacyStart")-      contract `shouldSatisfy` T.isInfixOf "keiro/behavior-conformance/1"-      contract `shouldSatisfy` T.isInfixOf "commandKind command == requirement.requirementCommandName"-      contract `shouldSatisfy` (not . T.isInfixOf "OPTIONS_GHC")-      contract `shouldSatisfy` T.isInfixOf "module Generated.BehaviorComplete.Journey.BehaviorContract\n  ( BehaviorKey (..)"-      contract `shouldSatisfy` T.isInfixOf "runRejection :: BehaviorRequirement"-      contract `shouldSatisfy` T.isInfixOf "failureSubject :: !Text"-      contract `shouldSatisfy` T.isInfixOf "\"subject\" .= behaviorFailure.failureSubject"-      contract `shouldSatisfy` T.isInfixOf "-- JourneyEmpty x Start: live transition"-      contract `shouldSatisfy` (not . T.isInfixOf "spec line")-      contract `shouldSatisfy` T.isInfixOf "requirementKey = BehaviorKey \"behavior-v1-"-      contract `shouldSatisfy` T.isInfixOf "requirementCommandName = \"Start\""-      contract `shouldSatisfy` T.isInfixOf "requirementExpectedEdge = (Just (K.EdgeRef JourneyEmpty 1))"-      contract `shouldSatisfy` T.isInfixOf "requirementCommandName = \"LegacyStart\""-      contract `shouldSatisfy` T.isInfixOf "requirementExpectedEdge = (Just (K.EdgeRef JourneyEmpty 2))"-      contract `shouldSatisfy` T.isInfixOf "runtime event values differ from the exact witness expectation; actual="-      T.count "Pending (BehaviorKey " behaviorHoles `shouldBe` 19-      behaviorHoles `shouldSatisfy` T.isInfixOf "-- JourneyEmpty x Start: live transition"-      behaviorHoles `shouldSatisfy` (not . T.isInfixOf "spec line")-      behaviorHoles `shouldSatisfy` (not . T.isInfixOf "undefined")-      behaviorHoles `shouldSatisfy` (not . T.isInfixOf "error")-      T.count "sampleRequestId :: RequestId" harness `shouldBe` 1-      T.count "sampleObservedAt :: UTCTime" harness `shouldBe` 1-      harness `shouldSatisfy` T.isInfixOf "Left problem -> error (show problem)"-      harness `shouldSatisfy` T.isInfixOf "sampleEventStarted = Started (StartedData sampleRequestId sampleObservedAt"-      harness `shouldSatisfy` T.isInfixOf "case step journeyTransducer (JourneyEmpty, initialJourneyRegs) (Start (StartData"-      harness `shouldSatisfy` T.isInfixOf "-- clock-free: spec samples no wall clock (verified at scaffold time)"-      harness `shouldSatisfy` (not . T.isInfixOf "(\"clock-free: spec samples no wall clock\", True)")-      codec `shouldSatisfy` T.isInfixOf "parseOptionalField (pure Nothing) (\\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) objectValue \"optional_note\""-      T.count "parseOptionalField ::" codec `shouldBe` 1-      projection `shouldSatisfy` T.isInfixOf "-- No projection declarations are present; this module keeps the generated manifest inventory total."--    it "rejects eventless state or register changes while accepting a true no-op" $ do-      invalid <--        parseInlineSpec "<eventless-change>" $-          T.unlines-            [ "language keiro-dsl 2",-              "context eventless-change",-              "aggregate Counter",-              "  regs",-              "    count Natural = 0",-              "  states Open Closed!",-              "  command Tick { count:Natural }",-              "  Open -- Tick --> write count := cmd.count ; goto Closed"-            ]-      errorCodes invalid `shouldContain` [AggregateEventlessStateChange]-      valid <--        parseInlineSpec "<eventless-noop>" $-          T.unlines-            [ "language keiro-dsl 2",-              "context eventless-noop",-              "aggregate Counter",-              "  regs",-              "    count Natural = 0",-              "  states Open",-              "  command Tick { count:Natural }",-              "  event Ticked = fields(Tick)",-              "  Open -- Tick --> goto Open"-            ]-      errorCodes valid `shouldBe` []--    it "refuses duplicate semantic behavior identities before scaffolding" $ do-      duplicate <--        parseInlineSpec "<duplicate-behavior>" $-          T.unlines-            [ "language keiro-dsl 2",-              "context duplicate-behavior",-              "aggregate Counter",-              "  regs",-              "  states Open",-              "  command Tick { amount:Natural }",-              "  event Ticked = fields(Tick)",-              "  Open -- Tick --> emit Ticked ; goto Open",-              "  Open -- Tick --> emit Ticked ; goto Open"-            ]-      let isBehaviorRefusal (BehaviorRefusal _) = True-          isBehaviorRefusal _ = False-      case planTestScaffold (defaultContext (duplicate.context)) duplicate of-        Left refusals -> refusals `shouldSatisfy` any isBehaviorRefusal-        Right _ -> expectationFailure "duplicate behavior identity reached a scaffold write set"--    it "round-trips additive single-file and workspace behavior rows with member ownership" $ do-      spec <- specOf "test/fixtures/behavior-complete.keiro"-      requirements <- either (\errors -> expectationFailure (show errors) >> pure []) pure (Behavior.deriveBehaviorRequirements spec)-      version <- maybe (expectationFailure "language version 2 was not constructible" >> fail "unreachable") pure (languageVersion 2)-      let rows = Behavior.behaviorRecordRows requirements-          singleRecord =-            ScaffoldRecord-              { specPath = "behavior-complete.keiro",-                moduleRoot = "",-                layout = "prefixed",-                sourceLanguage = DeclaredLanguage version noLoc,-                languageContract = effectiveLanguageContract (DeclaredLanguage version noLoc),-                namingEdition = IdiomaticNamingV1,-                moduleRoles = [],-                files = [],-                mappings = [],-                idDomains = [],-                nominalEqualities = [],-                bindingObligations = [],-                behaviorRequirements = rows,-                projectionCatalogFacts = [],-                queryContractBaseline = True,-                queryContracts = [],-                routerSelections = [],-                semanticImpact = Nothing-              }-      T.count "behavior " (renderRecord singleRecord) `shouldBe` 19-      parseRecord (renderRecord singleRecord) `shouldBe` Just singleRecord--      workspace <- shouldComposeWorkspace "test/fixtures/behavior-complete-workspace/service.keiro-workspace"-      workspaceRequirements <- either (\errors -> expectationFailure (show errors) >> pure []) pure (Behavior.deriveBehaviorRequirements ((.mergedSpec) workspace))-      let ownedRequirements =-            map-              (Behavior.attributeBehaviorOwner (fmap fst . nodeOwner ((.ownership) workspace) "aggregate"))-              workspaceRequirements-          ownedRows = Behavior.behaviorRecordRows ownedRequirements-          workspaceRecord =-            WorkspaceRecord-              { service = (.service) workspace,-                manifest = "service.keiro-workspace",-                context = workspace.context,-                moduleRoot = "",-                layout = "prefixed",-                members = map (.path) ((.members) workspace),-                sourceLanguages = [WorkspaceSourceLanguageRow ((.path) member) ((.sourceLanguage) member) | member <- (.members) workspace],-                languageContract = (.languageContract) workspace,-                namingEdition = IdiomaticNamingV1,-                modules = [],-                mappings = [],-                idDomains = [],-                nominalEqualities = [],-                bindingObligations = [],-                requirements = ownedRows,-                projectionCatalogFacts = [],-                queryContractBaseline = True,-                queryContracts = [],-                routerSelections = [],-                adopted = [],-                semanticImpact = Nothing-              }-      map (.owner) ownedRows `shouldSatisfy` all (== Just "journey.keiro")-      T.count "behavior " (renderWorkspaceRecord workspaceRecord) `shouldBe` 19-      parseWorkspaceRecord (renderWorkspaceRecord workspaceRecord) `shouldBe` Just workspaceRecord--    it "keeps the initial replay fixture byte-identical across single, workspace, and repeat scaffolds" $ do-      withTempDirectory "keiro-dsl-initial-replay-layout" $ \base -> do-        let singleOut = base </> "single"-            workspaceOut = base </> "workspace"-            singleSource = "test/fixtures/behavior-complete.keiro"-            workspaceSource = "test/fixtures/behavior-complete-workspace/service.keiro-workspace"-            journeyModules = filter (T.isPrefixOf "Generated/BehaviorComplete/Journey/" . T.pack . fst)-            behaviorContractPath = "Generated/BehaviorComplete/Journey/BehaviorContract.hs"-            withoutBehaviorContract = filter ((/= behaviorContractPath) . fst)-            present = maybe False (const True)-            normalizeRequirementLines =-              T.unlines-                . map-                  ( \sourceLine ->-                      if "requirementLine =" `T.isInfixOf` sourceLine-                        then fst (T.breakOn "=" sourceLine) <> "= <source-line>"-                        else case T.breakOn "(spec line " sourceLine of-                          (prefix, suffix)-                            | T.null suffix -> sourceLine-                            | otherwise -> prefix <> "(spec line <source-line>)"-                  )-                . T.lines-        (singleCode, singleStdout, singleStderr) <- runKeiroDsl ["scaffold", singleSource, "--out", singleOut]-        unless (singleCode == ExitSuccess) (expectationFailure (singleStdout <> singleStderr))-        singleTree <- treeSnapshot singleOut-        (singleRepeatCode, singleRepeatStdout, singleRepeatStderr) <- runKeiroDsl ["scaffold", singleSource, "--out", singleOut]-        unless (singleRepeatCode == ExitSuccess) (expectationFailure (singleRepeatStdout <> singleRepeatStderr))-        treeSnapshot singleOut `shouldReturn` singleTree-        (workspaceCode, workspaceStdout, workspaceStderr) <- runKeiroDsl ["scaffold", workspaceSource, "--out", workspaceOut]-        unless (workspaceCode == ExitSuccess) (expectationFailure (workspaceStdout <> workspaceStderr))-        workspaceTree <- treeSnapshot workspaceOut-        let singleJourney = journeyModules singleTree-            workspaceJourney = journeyModules workspaceTree-        withoutBehaviorContract workspaceJourney `shouldBe` withoutBehaviorContract singleJourney-        case (lookup behaviorContractPath workspaceJourney, lookup behaviorContractPath singleJourney) of-          (Just workspaceContract, Just singleContract) ->-            normalizeRequirementLines workspaceContract `shouldBe` normalizeRequirementLines singleContract-          (workspaceContract, singleContract) ->-            expectationFailure-              ( "expected both generated behavior contracts, got "-                  <> show (present workspaceContract, present singleContract)-              )-        (workspaceRepeatCode, workspaceRepeatStdout, workspaceRepeatStderr) <- runKeiroDsl ["scaffold", workspaceSource, "--out", workspaceOut]-        unless (workspaceRepeatCode == ExitSuccess) (expectationFailure (workspaceRepeatStdout <> workspaceRepeatStderr))-        treeSnapshot workspaceOut `shouldReturn` workspaceTree--  describe "nominal consumer types" $ do-    it "resolves every category through one checked registry and explains exact obligations" $ do-      spec <- specOf "test/fixtures/nominal-scalars.keiro"-      errorCodes spec `shouldBe` []-      registry <- case resolveNominalTypes spec of-        Left errors -> expectationFailure (show errors) >> fail "unreachable"-        Right value -> pure value-      Map.keys (nominalTypes registry)-        `shouldBe` ["AccountNumber", "FeatureFlag", "ObservedAt", "OrderId", "OrderStatus", "RiskScore", "SequenceNumber"]-      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligations spec)-      length obligations `shouldBe` 21-      map (.category) obligations `shouldSatisfy` all (`elem` ["nominal-id", "nominal-enum", "nominal-scalar"])-      length [() | obligation <- obligations, (.equalityContract) obligation /= Nothing] `shouldBe` 2-      renderBindingObligations (spec.context) obligations `shouldSatisfy` T.isInfixOf "equality-contract:"-      let signatures = map (.signature) obligations-      forM_-        [ "orderIdBinding :: NominalBinding NominalConformance.Domain.OrderId (KindID \"ord\")",-          "orderStatusBinding :: NominalBinding NominalConformance.Domain.OrderStatus Generated.NominalScalars.Nominal.Shape.OrderStatus.OrderStatusRepresentation",-          "accountNumberBinding :: NominalBinding NominalConformance.Domain.AccountNumber Text",-          "orderIdFixtures :: NominalFixtureCases NominalConformance.Domain.OrderId",-          "initialAccountNumber :: NominalConformance.Domain.AccountNumber"-        ]-        (`shouldSatisfy` (`elem` signatures))-      map (.canonicalType) obligations `shouldSatisfy` all (/= Nothing)-      let rendered = renderBindingObligations (spec.context) obligations-      rendered `shouldSatisfy` T.isInfixOf "nominal-id type OrderId"-      rendered `shouldSatisfy` T.isInfixOf "canonical-type: \"nominal.OrderId.v1\""-      case obligations of-        firstObligation : _ ->-          (Aeson.eitherDecode (Aeson.encode firstObligation) :: Either String BindingObligation)-            `shouldBe` Right firstObligation-        [] -> expectationFailure "expected nominal binding obligations"--    it "allocates distinct stable diagnostics for incomplete or incompatible nominal declarations" $ do-      missing <- errorCodesOf "test/fixtures/nominal-missing-facts.keiro"-      missing `shouldBe` replicate 5 NominalMissingIngredient-      errorCodesOf "test/fixtures/nominal-bad-qualified.keiro" `shouldReturn` [NominalInvalidQualifiedName]-      errorCodesOf "test/fixtures/nominal-invalid-prefix.keiro" `shouldReturn` replicate 2 NominalInvalidIdPrefix-      errorCodesOf "test/fixtures/nominal-unsupported-representation.keiro" `shouldReturn` [NominalUnsupportedRepresentation]-      errorCodesOf "test/fixtures/nominal-missing-initial.keiro" `shouldReturn` [NominalMissingInitialValue]-      errorCodesOf "test/fixtures/nominal-name-collision.keiro"-        `shouldReturn` [NominalNameCollision, GeneratedOccurrenceCollision, NominalNameCollision]--    it "keeps v1 rejection at the source-language boundary" $ do-      source <- readTestText "test/fixtures/nominal-v1.keiro"-      case parseSource "nominal-v1.keiro" source of-        Left (SourceLanguageFailure diagnostic) -> (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion-        other -> expectationFailure ("expected source-language refusal, got " <> show other)--    it "scaffolds consumer types, checked codecs, enum representation, projections, and deterministic manifests" $ do-      spec <- specOf "test/fixtures/nominal-scalars.keiro"-      let ctx = defaultContext (spec.context)-          modules = scaffoldModules ctx spec-          moduleAt path = case [value | value <- modules, value.path == path] of-            [value] -> pure value-            values -> expectationFailure ("expected one module at " <> path <> ", got " <> show (map (.path) values)) >> fail "unreachable"-      domainModule <- moduleAt "Generated/NominalScalars/NominalLedger/Domain.hs"-      codecModule <- moduleAt "Generated/NominalScalars/NominalLedger/Codec.hs"-      enumModule <- moduleAt "Generated/NominalScalars/Nominal/Shape/OrderStatus.hs"-      projectionModule <- moduleAt "Generated/NominalScalars/NominalProjections.hs"-      bindingModule <- moduleAt "NominalConformance/Bindings.hs"-      map (.path) modules `shouldNotContain` ["NominalScalars/NominalLedger/Holes.hs"]-      (.text) domainModule `shouldSatisfy` T.isInfixOf "import NominalConformance.Domain (AccountNumber, FeatureFlag, ObservedAt, OrderId, OrderStatus, RiskScore, SequenceNumber)"-      (.text) domainModule `shouldSatisfy` T.isInfixOf "orderId :: !OrderId"-      (.text) domainModule `shouldSatisfy` (not . T.isInfixOf "NominalConformance.Domain.OrderId")-      (.text) domainModule `shouldSatisfy` (not . T.isInfixOf "newtype OrderId")-      (.text) domainModule `shouldSatisfy` (not . T.isInfixOf "data OrderStatus =")-      (.text) codecModule `shouldSatisfy` T.isInfixOf "KindID.parseText @\"ord\""-      (.text) codecModule `shouldSatisfy` T.isInfixOf "KindID.toText (nominalToRepresentation"-      (.text) codecModule `shouldSatisfy` T.isInfixOf "nominalFromRepresentation"-      forM_ ["coerce", "unsafe", "read ", "error "] $ \forbidden ->-        (.text) codecModule `shouldSatisfy` (not . T.isInfixOf forbidden)-      (.text) enumModule `shouldSatisfy` T.isInfixOf "data OrderStatusRepresentation = Draft | Submitted"-      (.text) enumModule `shouldSatisfy` (not . T.isInfixOf "NominalConformance")-      (.text) projectionModule `shouldSatisfy` T.isInfixOf "type FieldOwner AccountNumberNominalProjection = AccountNumber"-      (.text) projectionModule `shouldSatisfy` T.isInfixOf "projectFieldValue _ = nominalToRepresentation Bindings.accountNumberBinding"-      (.text) projectionModule `shouldSatisfy` T.isInfixOf "instance ExactFieldProjection OrderIdEqualityProjection"-      (.text) projectionModule `shouldSatisfy` T.isInfixOf "textProjectionDomain orderIdEqualityPattern"-      (.text) projectionModule `shouldSatisfy` T.isInfixOf "instance ExactFieldProjection OrderStatusEqualityProjection"-      (.text) projectionModule `shouldSatisfy` T.isInfixOf "finiteProjectionDomain (\"draft\" :| [\"submitted\"])"-      (.kind) bindingModule `shouldBe` HoleStub-      (.text) bindingModule `shouldSatisfy` T.isInfixOf "import NominalConformance.Domain (AccountNumber, FeatureFlag, ObservedAt, OrderId, OrderStatus, RiskScore, SequenceNumber)"-      (.text) bindingModule `shouldSatisfy` T.isInfixOf "orderIdBinding :: NominalBinding OrderId (KindID \"ord\")"-      (.text) bindingModule `shouldSatisfy` T.isInfixOf "orderStatusBinding :: NominalBinding OrderStatus ShapeOrderStatus.OrderStatusRepresentation"-      firewallBreaches modules `shouldBe` []-      scaffoldModules ctx spec `shouldBe` modules-      manifestDependencies spec `shouldContain` ["mmzk-typeid", "nominal-conformance"]--    it "persists nominal provenance in a separate forward-compatible row kind" $ do-      spec <- specOf "test/fixtures/nominal-scalars.keiro"-      workspace <- shouldComposeWorkspace canonicalWorkspacePath-      let plan = consumerPlan spec-          record =-            ScaffoldRecord-              { specPath = "nominal-scalars.keiro",-                moduleRoot = "",-                layout = "prefixed",-                sourceLanguage = LegacyUnversioned,-                languageContract = effectiveLanguageContract LegacyUnversioned,-                namingEdition = IdiomaticNamingV1,-                moduleRoles = [],-                files = [],-                mappings = (.mappings) plan,-                idDomains = [],-                nominalEqualities = nominalEqualityIdentities spec,-                bindingObligations = [],-                behaviorRequirements = [],-                projectionCatalogFacts = [],-                queryContractBaseline = True,-                queryContracts = [],-                routerSelections = [],-                semanticImpact = Nothing-              }-          encoded = renderRecord record-          workspaceRecord =-            (sampleWorkspaceRecord workspace)-              { WorkspaceRecord.mappings = plan.mappings-              }-          workspaceEncoded = renderWorkspaceRecord workspaceRecord-      (.packages) plan `shouldBe` ["nominal-conformance"]-      length [() | NominalMapping {} <- (.mappings) plan] `shouldBe` 7-      T.count "nominal-mapping " encoded `shouldBe` 7-      T.count "nominal-equality " encoded `shouldBe` 2-      T.count "\nmapping " encoded `shouldBe` 0-      parseRecord encoded `shouldBe` Just record-      T.count "nominal-mapping " workspaceEncoded `shouldBe` 7-      T.count "nominal-equality " workspaceEncoded `shouldSatisfy` (>= 2)-      T.count "\nmapping " workspaceEncoded `shouldBe` 0-      parseWorkspaceRecord workspaceEncoded `shouldBe` Just workspaceRecord--    it "reports bound-ID decoder tightening and makes binding provenance replay-visible" $ do-      current <- specOf "test/fixtures/nominal-scalars.keiro"-      let useGeneratedIdInitial (NAggregate aggregate) =-            NAggregate-              ( aggregateWithRegs-                  [ if register.name == "orderId"-                      then regDeclWithInitial (RegInitBare "placeholder") register-                      else register-                  | register <- aggregate.regs-                  ]-                  aggregate-              )-          useGeneratedIdInitial node = node-          unbound =-            specWithIdsAndNodes-              [idDeclWithBinding Nothing declaration | declaration <- current.ids]-              (map useGeneratedIdInitial current.nodes)-              current-          adoption = diffSpecs unbound current-          decoderFindings = [kindOfChange change | change <- adoption, changeCode change == NominalIdDecoderTightened]-      map (.subject) decoderFindings `shouldContain` ["NominalLedger event NominalsRecorded .orderId"]-      decoderFindings `shouldSatisfy` all ((== VAdvisory) . verdictFor PrivateHistoryRead . (.vector))-      let bumped =-            specWithIds-              [ idDeclWithBinding (fmap (nominalBindingWithVersion (Just "2")) declaration.binding) declaration-              | declaration <- current.ids-              ]-              current-          bindingChanges = diffSpecs current bumped-      map changeCode bindingChanges `shouldContain` [NominalBindingChanged]-      replayImpactSpecs current bumped `shouldSatisfy` \case-        ReplayImpact.ReplayAffected impacts ->-          maybe False (\impact -> Set.member "NominalsRecorded" ((.eventTypes) impact) && (.includeSnapshotStreams) impact) (Map.lookup "NominalLedger" impacts)-        ReplayImpact.ReplayNeutral -> False-      case [aggregate | NAggregate aggregate <- (.nodes) current] of-        aggregate : _ -> do-          aggregateFoldSurface current aggregate `shouldSatisfy` T.isInfixOf "nominal-equality-use:"-          aggregateFoldSurface current aggregate `shouldNotBe` aggregateFoldSurface bumped aggregate-        [] -> expectationFailure "expected nominal aggregate"--  describe "historical codec comparison" $ do-    it "treats object-key order as RFC 8785 parity" $ do-      let historical = object ["z" .= (1 :: Int), "a" .= (2 :: Int)]-          generated = object ["a" .= (2 :: Int), "z" .= (1 :: Int)]-      classifyObservation (EncodeObservation "ordered-object" historical generated)-        `shouldBe` Right JsonParity-    it "classifies an omitted key versus explicit null as version work at that pointer" $ do-      let historical = object []-          generated = object ["description" .= Aeson.Null]-      classifyObservation (EncodeObservation "absent-description" historical generated)-        `shouldBe` Right (RequiresVersionWork (EncodedValueDifference (JsonPointer "/description") historical generated))-    it "classifies generated rejection of a historical value as version work" $-      classifyObservation-        ( DecodeObservation-            "legacy.json"-            (object ["tag" .= ("legacy" :: T.Text)])-            (DecodedShape (object ["tag" .= ("legacy" :: T.Text)]))-            (DecodeFailed "unknown tag")-        )-        `shouldBe` Right (RequiresVersionWork (GeneratedDecodeRejected "unknown tag"))-    it "treats historical-codec rejection as invalid input rather than parity" $-      classifyObservation-        ( DecodeObservation-            "corrupt.json"-            Aeson.Null-            (DecodeFailed "not historical data")-            (DecodeFailed "not generated data")-        )-        `shouldBe` Left (HistoricalCodecRejected "corrupt.json" "not historical data")-    it "reports uncovered union arms separately by corpus origin" $ do-      let canonical = DeclaredBranch HistoricalGolden (JsonPointer "/location") (UnionArm "canonical")-          local = DeclaredBranch HistoricalGolden (JsonPointer "/location") (UnionArm "local_file")-          report = compareReport comparisonProvenance [] [] [canonical, local] [ObservedBranch HistoricalGolden (JsonPointer "/location") (UnionArm "local_file")]-      (.coverageGaps) report-        `shouldBe` [CoverageGap HistoricalGolden (JsonPointer "/location") (UnionArm "canonical")]-      reportSucceeded report `shouldBe` False-    it "derives optional, null, and union-arm observations from a generated branch schema" $ do-      let schema =-            BranchRecord-              [ BranchField "description" True (BranchOptional BranchScalar),-                BranchField "location" False (BranchUnion "tag" "contents" [BranchArm "local" (Just BranchScalar), BranchArm "canonical" Nothing])-              ]-          historical = object ["location" .= object ["tag" .= ("canonical" :: T.Text)]]-      observedBranchesFor HistoricalGolden schema historical-        `shouldBe` [ ObservedBranch HistoricalGolden (JsonPointer "/description") OptionalMissing,-                     ObservedBranch HistoricalGolden (JsonPointer "/location") (UnionArm "canonical")-                   ]-      let declared = declaredBranchesFor HistoricalGolden schema-      forM_-        [ DeclaredBranch HistoricalGolden (JsonPointer "/description") OptionalMissing,-          DeclaredBranch HistoricalGolden (JsonPointer "/description") OptionalPresent,-          DeclaredBranch HistoricalGolden (JsonPointer "/description") ExplicitNull,-          DeclaredBranch HistoricalGolden (JsonPointer "/location") (UnionArm "local"),-          DeclaredBranch HistoricalGolden (JsonPointer "/location") (UnionArm "canonical")-        ]-        (\branch -> declared `shouldContain` [branch])-    it "round-trips the stable machine report" $ do-      let observation = EncodeObservation "parity" (object ["a" .= (1 :: Int)]) (object ["a" .= (1 :: Int)])-          report = compareReport comparisonProvenance [] [observation] [] []-      Aeson.eitherDecode (Aeson.encode report) `shouldBe` Right report-    it "atomically writes and replaces the machine report" $-      withTempDirectory "keiro-dsl-codec-compare" $ \out -> do-        let path = out </> "report.json"-            firstReport = compareReport comparisonProvenance [] [] [] []-            secondReport = compareReport comparisonProvenance [HistoricalGoldenUnreadable "bad.json" "bad JSON"] [] [] []-        writeCompareReportAtomic path firstReport `shouldReturn` Right ()-        Aeson.eitherDecodeFileStrict path `shouldReturn` Right firstReport-        writeCompareReportAtomic path secondReport `shouldReturn` Right ()-        Aeson.eitherDecodeFileStrict path `shouldReturn` Right secondReport--  describe "historical codec comparison scaffold" $ do-    it "emits an opt-in non-production runner without entering the ordinary module registry" $ do-      spec <- specOf "test/fixtures/structural-conformance.keiro"-      let ctx = defaultContext (spec.context)-          planned = codecComparisonModule ctx spec "ArtifactInfo"-          ordinary = scaffoldModules ctx spec-      case planned of-        Left err -> expectationFailure (T.unpack err)-        Right comparisonModule -> do-          (.path) comparisonModule-            `shouldBe` "Generated/StructuralConformance/Structural/CodecCompare/ArtifactInfo.hs"-          (.text) comparisonModule `shouldSatisfy` T.isInfixOf codecComparisonBanner-          (.text) comparisonModule `shouldSatisfy` T.isInfixOf "Generated.StructuralConformance.ArtifactCatalog.Codec qualified as GeneratedCodec"-          (.text) comparisonModule `shouldSatisfy` T.isInfixOf "branchSchema = BranchRecord"-          map (.path) ordinary `shouldNotContain` [(.path) comparisonModule]-    it "refuses opaque selections rather than upgrading their claim" $ do-      spec <- specOf "test/fixtures/structural-conformance.keiro"-      codecComparisonModule (defaultContext (spec.context)) spec "VendorGeometry"-        `shouldSatisfy` either (T.isInfixOf "is opaque") (const False)--  describe "structural/opaque coverage reporting" $ do-    it "reports mapped private-event roots and consumer-json register boundaries without a percentage" $ do-      spec <- specOf "test/fixtures/structural-conformance.keiro"-      report <- shouldResolveCoverage "structural-conformance.keiro" spec-      (.privateEventPayloads) ((.summary) report)-        `shouldBe` Coverage.CoverageCounts 2 1 1 0-      (.snapshotRegisters) ((.summary) report)-        `shouldBe` Coverage.CoverageCounts 2 1 1 0-      map (.mappedType) ((.opaqueBoundaries) report)-        `shouldBe` ["VendorGeometry"]-      map (.encoding) ((.snapshotBoundaries) report)-        `shouldBe` ["consumer-json-cache", "consumer-json-cache"]-      map (.invalidation) ((.snapshotBoundaries) report)-        `shouldBe` ["tracked-by-mapped-wire-fingerprint", "tracked-by-mapped-wire-fingerprint"]-      map (.code) ((.findings) report)-        `shouldBe` [CoverageOpaqueSurface]-      map (.severity) ((.findings) report)-        `shouldBe` [Warning]-      case Aeson.toJSON report of-        Aeson.Object values ->-          forM_ ["spec", "roots", "opaqueBoundaries", "snapshotBoundaries", "unsupportedSurfaces"] $-            \key -> KeyMap.member key values `shouldBe` True-        value -> expectationFailure ("coverage report was not an object: " <> show value)-    it "reports queue structural and Json boundaries as a separate persisted surface" $ do-      source <- mappedConsumerSurfaceSource-      spec <- parseInlineSpec "<mapped-queue-coverage>" source-      report <- shouldResolveCoverage "mapped-queue.keiro" spec-      (.workqueuePayloads) ((.summary) report)-        `shouldBe` Coverage.CoverageCounts 1 1 0 1-      map (.path) [root | root <- (.roots) report, (.surface) root == Coverage.WorkqueuePayload]-        `shouldBe` ["workqueue ArtifactJobs payload .jobData : ArtifactInfo [] optional"]-      map (.path) [boundary | boundary <- (.jsonBoundaries) report, (.surface) boundary == Coverage.WorkqueuePayload]-        `shouldContain` ["workqueue ArtifactJobs payload .jobData : ArtifactInfo [] optional .extra"]-      map (.surface) ((.unsupportedSurfaces) report)-        `shouldNotContain` ["queue-payloads"]-    it "reports a built-in-only queue Json expression without fabricating a mapped declaration" $ do-      source <- mappedConsumerSurfaceSource-      spec <--        parseInlineSpec-          "<explicit-queue-json-coverage>"-          (T.replace "jobData -> \"payload\" : List (Optional ArtifactInfo)" "jobData -> \"payload\" : Optional Json" source)-      report <- shouldResolveCoverage "explicit-queue-json.keiro" spec-      (.workqueuePayloads) ((.summary) report)-        `shouldBe` Coverage.CoverageCounts 0 0 0 1-      map (.path) [boundary | boundary <- (.jsonBoundaries) report, (.surface) boundary == Coverage.WorkqueuePayload]-        `shouldBe` ["workqueue ArtifactJobs payload .jobData optional"]-    it "reports explicit Json leaves by their complete persisted path" $ do-      spec <- withMetadataJson <$> specOf "test/fixtures/structural-conformance.keiro"-      report <- shouldResolveCoverage "structural-conformance-json.keiro" spec-      (.jsonBoundaries) ((.privateEventPayloads) ((.summary) report))-        `shouldBe` 1-      map (.path) ((.jsonBoundaries) report)-        `shouldBe` ["ArtifactCatalog event ArtifactRecorded .artifact : ArtifactInfo .metadata : ArtifactMetadata .note"]-    it "keeps a zero-opaque spec advisory-free and makes rejection explicitly opt-in" $ do-      original <- specOf "test/fixtures/structural-conformance.keiro"-      clear <- shouldResolveCoverage "structural-only.keiro" (withoutVendorGeometry original)-      (.opaqueRoots) ((.privateEventPayloads) ((.summary) clear)) `shouldBe` 0-      (.opaqueBoundaries) clear `shouldBe` []-      (.findings) clear `shouldBe` []-      opaque <- shouldResolveCoverage "structural-conformance.keiro" original-      Coverage.coverageSucceeded opaque `shouldBe` True-      let gated = Coverage.failOnOpaque opaque-      Coverage.coverageSucceeded gated `shouldBe` False-      map (.code) ((.findings) gated)-        `shouldBe` [CoverageOpaqueSurface, CoverageOpaqueGateExceeded]-      map (.severity) ((.findings) gated)-        `shouldBe` [Warning, Error]-    it "diffs named opaque boundaries and fails only an explicitly gated increase" $ do-      newSpec <- specOf "test/fixtures/structural-conformance.keiro"-      report <- case Coverage.coverageDiffReport "structural-conformance.keiro" "HEAD" (withoutVendorGeometry newSpec) newSpec of-        Left err -> expectationFailure (show err) >> fail "unreachable"-        Right value -> pure value-      fmap (.opaqueBoundaryDelta) ((.delta) report) `shouldBe` Just 1-      fmap (map (.mappedType) . (.addedOpaqueBoundaries)) ((.delta) report)-        `shouldBe` Just ["VendorGeometry"]-      map (.code) ((.findings) report)-        `shouldBe` [CoverageOpaqueSurface, CoverageOpaqueBoundaryAdded]-      Coverage.coverageSucceeded report `shouldBe` True-      let gated = Coverage.failOnOpaqueIncrease report-      Coverage.coverageSucceeded gated `shouldBe` False-      map (.code) ((.findings) gated)-        `shouldBe` [CoverageOpaqueSurface, CoverageOpaqueBoundaryAdded, CoverageOpaqueGateExceeded]-    it "appends the six stable coverage and comparison registry codes" $-      map-        show-        [ CoverageOpaqueSurface,-          CoverageOpaqueBoundaryAdded,-          CoverageOpaqueGateExceeded,-          CodecCompareDifference,-          CodecCompareCoverageGap,-          CodecCompareInvalidInput-        ]-        `shouldBe` [ "CoverageOpaqueSurface",-                     "CoverageOpaqueBoundaryAdded",-                     "CoverageOpaqueGateExceeded",-                     "CodecCompareDifference",-                     "CodecCompareCoverageGap",-                     "CodecCompareInvalidInput"-                   ]--  describe "parse . pretty round-trip" $-    do-      it "re-parses any generated spec to an equal AST (modulo source locations)" $-        checkCoverage $-          forAll genSpec $ \s ->-            let families = map nodeTag ((.nodes) s)-                roundTrip = parseSpec "<gen>" (renderSpec s) === Right s-             in cover 5 (not (null ((.mapped) s))) "mapped" $-                  foldr (\family -> cover 1 (family `elem` families) family) roundTrip allNodeTags-      it "round-trips an aggregate with no states" $-        parseSpec "<empty-states>" (renderSpec emptyStatesSpec) `shouldBe` Right emptyStatesSpec-      it "separates transition emit clauses from following nodes" $ do-        spec <- parseInlineSpec "<cross-family-boundaries>" crossFamilyBoundarySpec-        case (.nodes) spec of-          [NAggregate first, NEmit _, NAggregate second, NPgmqDispatch _] -> do-            concatMap (.emits) ((.transitions) first) `shouldBe` ["Changed"]-            (.states) second `shouldBe` []-          nodes -> expectationFailure ("unexpected node sequence: " <> show (map nodeTag nodes))--  describe "mapped types (EP-149)" $ do-    it "round-trips the canonical structural and opaque consumer fixture" $ do-      source <- TIO.readFile "test/fixtures/consumer-types.keiro"-      spec <- parseInlineSpec "test/fixtures/consumer-types.keiro" source-      parseStableRenderedSpec "<consumer-types-round-trip>" spec `shouldBe` Right spec-      length ((.mapped) spec) `shouldBe` 4-    it "preserves every missing-value policy, nested type expression, and unit union arm" $ do-      source <- TIO.readFile "test/fixtures/consumer-types.keiro"-      spec <- parseInlineSpec "test/fixtures/consumer-types.keiro" source-      let fields = [field | MappedStructural {msShape = ShapeRecord _ _ recordFields} <- (.mapped) spec, field <- recordFields]-          arms = [arm | MappedStructural {msShape = ShapeUnion _ unionArms} <- (.mapped) spec, arm <- unionArms]-      [value | field <- fields, Just value <- [(.onMissing) field]]-        `shouldBe` [OmCtor "Guide", OmNull, OmInt 0, OmBool False, OmEmptyList, OmEmptyMap]-      [(.valueType) field | field <- fields, (.haskell) field == "labels"]-        `shouldBe` [TList (TOptional TText)]-      [(.ctor) arm | arm <- arms, (.payload) arm == Nothing]-        `shouldBe` ["Unknown"]-    it "rejects every mapped validation fixture with its stable diagnostic code" $ do-      let cases =-            [ ("mapped-unresolved.keiro", MappedUnresolvedName),-              ("mapped-ambiguous.keiro", MappedAmbiguousName),-              ("mapped-dup-fieldname.keiro", MappedDuplicateFieldName),-              ("mapped-dup-wirekey.keiro", MappedDuplicateWireKey),-              ("mapped-dup-armname.keiro", MappedDuplicateArmName),-              ("mapped-dup-tag.keiro", MappedDuplicateWireTag),-              ("mapped-recursive.keiro", MappedRecursiveType),-              ("mapped-recursive-mutual.keiro", MappedRecursiveType),-              ("mapped-bad-encoding.keiro", MappedUnsupportedEncoding),-              ("mapped-union-key-collision.keiro", MappedUnsupportedEncoding),-              ("mapped-optional-json.keiro", MappedNonInjectiveNullability),-              ("mapped-optional-optional.keiro", MappedNonInjectiveNullability),-              ("mapped-optional-opaque.keiro", MappedNonInjectiveNullability),-              ("mapped-missing-binding.keiro", MappedMissingIngredient),-              ("mapped-missing-binding-version.keiro", MappedMissingIngredient),-              ("mapped-missing-canonical.keiro", MappedMissingIngredient),-              ("mapped-missing-fixture.keiro", MappedMissingIngredient),-              ("mapped-missing-initial.keiro", MappedMissingInitialValue),-              ("mapped-bad-haskell-name.keiro", MappedInvalidHaskellName),-              ("mapped-empty-identity.keiro", MappedInvalidIdentity),-              ("mapped-import-conflict.keiro", MappedImportConflict),-              ("mapped-illtyped-default.keiro", MappedDefaultIllTyped),-              ("mapped-guard.keiro", AggregateExpressionOperatorUnsupported)-            ]-      forM_ cases $ \(fixture, expected) ->-        errorCodesOf ("test/fixtures/" <> fixture) `shouldReturn` [expected]-    it "keeps Time and Natural in Keiki's curated comparison set" $ do-      errorCodesOf "test/fixtures/mapped-guard-time.keiro" `shouldReturn` []-      errorCodesOf "test/fixtures/mapped-guard-natural.keiro" `shouldReturn` []-    it "rejects required defaults, missing optional policies, Int overflow, and negative Natural defaults" $ do-      let invalidFields =-            [ WireField "requiredDefault" "requiredDefault" TText PRequired (Just (OmText "x")) noLoc,-              WireField "missingPolicy" "missingPolicy" TText POptional Nothing noLoc,-              WireField "overflow" "overflow" TInt POptional (Just (OmInt (toInteger (maxBound :: Int) + 1))) noLoc,-              WireField "negativeNatural" "negativeNatural" TNatural POptional (Just (OmInt (-1))) noLoc-            ]-          declaration = completeStructural "Defaults" (ShapeRecord "Defaults" RejectUnknown invalidFields)-      errorCodes (mappedSpec [declaration])-        `shouldBe` [MappedDefaultIllTyped, MappedMissingIngredient, MappedDefaultIllTyped, MappedDefaultIllTyped]--  describe "aggregate type capabilities" $ do-    it "enumerates the policy for every resolved type and use site" $ do-      let resolvedTypes =-            [ AggregateText,-              AggregateInt,-              AggregateBool,-              AggregateTime,-              AggregateNatural,-              AggregateNominal (ResolvedNominalType "EntityId" (IdRepresentation "ent") GeneratedNominal noLoc),-              AggregateNominal (ResolvedNominalType "Status" (EnumRepresentation (("Active", "active") :| [])) GeneratedNominal noLoc),-              AggregateNominal (ResolvedNominalType "Amount" (ScalarRepresentation NominalInt) (consumerNominalFor "Amount") noLoc),-              AggregateNominal (ResolvedNominalType "Label" (ScalarRepresentation NominalText) (consumerNominalFor "Label") noLoc),-              AggregateVertex "EntityVertex",-              AggregateMapped (MappedKey "ConsumerValue")-            ]-          useSites = [minBound .. maxBound]-          expected useSite resolvedType = case useSite of-            OrderingGuardUse -> case resolvedType of-              AggregateInt -> SolverVisible-              AggregateTime -> SolverVisible-              AggregateNatural -> SolverVisible-              AggregateNominal nominal -> case (.representation) nominal of-                ScalarRepresentation NominalInt -> SolverVisible-                ScalarRepresentation NominalNatural -> SolverVisible-                ScalarRepresentation NominalTime -> SolverVisible-                _ -> Unsupported-              _ -> Unsupported-            EqualityGuardUse -> case resolvedType of-              AggregateMapped {} -> Unsupported-              AggregateNominal {} -> SolverVisible-              AggregateVertex {} -> OpaqueOnly-              _ -> SolverVisible-            _ -> case resolvedType of-              AggregateNominal nominal -> case (.representation) nominal of-                ScalarRepresentation {} -> SolverVisible-                _ -> OpaqueOnly-              AggregateVertex {} -> OpaqueOnly-              AggregateMapped {} -> OpaqueOnly-              _ -> SolverVisible-          actual =-            [ (useSite, resolvedType, aggregateCapability useSite resolvedType)-            | useSite <- useSites,-              resolvedType <- resolvedTypes-            ]-          wanted =-            [ (useSite, resolvedType, expected useSite resolvedType)-            | useSite <- useSites,-              resolvedType <- resolvedTypes-            ]-      actual `shouldBe` wanted-    it "lowers direct Time and Natural through every generated aggregate boundary" $ do-      spec <- specOf "test/fixtures/aggregate-scalars.keiro"-      errorCodes spec `shouldBe` []-      let aggregate = onlyAggregate spec-          modules = scaffoldAggregate (defaultContext (spec.context)) spec aggregate-          generated =-            [ (.text) generatedModule-            | generatedModule <- modules,-              (.kind) generatedModule == Generated-            ]-          domain = generatedTextEndingIn "Domain.hs" modules-          codec = generatedTextEndingIn "Codec.hs" modules-      domain `shouldSatisfy` T.isInfixOf "observedAt :: !UTCTime"-      domain `shouldSatisfy` T.isInfixOf "revision :: !Natural"-      domain `shouldSatisfy` T.isInfixOf "UTCTime (fromGregorian 2026 1 2) (picosecondsToDiffTime 11045123456789012)"-      domain `shouldSatisfy` T.isInfixOf "import Data.Time.Calendar (fromGregorian)"-      domain `shouldSatisfy` T.isInfixOf "import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)"-      domain `shouldSatisfy` T.isInfixOf "import Numeric.Natural (Natural)"-      manifestDependencies spec `shouldContain` ["time"]-      manifestDependencies spec `shouldNotContain` ["keiki-codec-json"]-      codec `shouldSatisfy` T.isInfixOf "scalarLedgerEventTypes :: NonEmpty EventType"-      codec `shouldSatisfy` T.isInfixOf "eventTypes = scalarLedgerEventTypes"-      codec `shouldSatisfy` T.isInfixOf "renderExpectedEventTypes scalarLedgerEventTypes"-      codec `shouldSatisfy` (not . T.isInfixOf "; expected one of: ScalarsRecorded\"")-      generated `shouldSatisfy` all (not . T.isInfixOf "error")-      generated `shouldSatisfy` all (not . T.isInfixOf "getCurrentTime")-      generated `shouldSatisfy` all (not . T.isInfixOf "iso8601ParseM")-    it "keeps the event-list binding disjoint from the private formatter" $ do-      source <- readTestText "test/fixtures/aggregate-scalars.keiro"-      spec <- parseInlineSpec "<render-aggregate>" (T.replace "aggregate ScalarLedger" "aggregate Render" source)-      let aggregate = onlyAggregate spec-          modules = scaffoldAggregate (defaultContext (spec.context)) spec aggregate-          codec = generatedTextEndingIn "Codec.hs" modules-          codecLines = T.lines codec-      codecLines `shouldContain` ["renderEventTypes :: NonEmpty EventType"]-      codecLines `shouldContain` ["renderExpectedEventTypes :: NonEmpty EventType -> String"]-      codec `shouldSatisfy` T.isInfixOf "eventTypes = renderEventTypes"-      codec `shouldSatisfy` T.isInfixOf "renderExpectedEventTypes renderEventTypes"-    it "canonicalizes Time and UTCTime across pretty, diff, and fold identity" $ do-      source <- readTestText "test/fixtures/aggregate-scalars.keiro"-      canonical <- parseInlineSpec "<time>" source-      alias <- parseInlineSpec "<utctime>" (T.replace ":Time" ":UTCTime" (T.replace " Time =" " UTCTime =" source))-      renderSpec alias `shouldBe` renderSpec canonical-      legacyDiffSpecs canonical alias `shouldBe` []-      legacyAggregateFoldFingerprint canonical (onlyAggregate canonical)-        `shouldBe` legacyAggregateFoldFingerprint alias (onlyAggregate alias)-      legacyAggregateFoldSurface canonical (onlyAggregate canonical)-        `shouldBe` legacyAggregateFoldSurface alias (onlyAggregate alias)-    it "keeps the committed scalar conformance generated tree fresh" $ do-      modules <- scaffoldFixture "test/fixtures/aggregate-scalars.keiro"-      forM_ [generatedModule | generatedModule <- modules, (.kind) generatedModule == Generated] $ \generatedModule -> do-        committed <- readTestText ("test/conformance-aggregate-scalars/" <> (.path) generatedModule)-        normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) generatedModule)-    it "never sends a clean scalar aggregate to a type scaffold refusal" $-      property $-        forAll (elements scalarRegisterCases) $ \(typeName, initialValue) ->-          case parseSpec "<clean-scalar>" (cleanScalarAggregateSpec typeName initialValue) of-            Left parseError -> counterexample (T.unpack parseError) False-            Right spec ->-              let diagnostics = [diagnostic | diagnostic <- validateSpec spec, (.severity) diagnostic == Error]-                  modules = scaffoldModules (defaultContext (spec.context)) spec-               in counterexample-                    (show diagnostics <> "\n" <> show (scaffoldRefusals spec))-                    ( null diagnostics-                        && null (scaffoldRefusals spec)-                        && all (not . T.null . (.text)) modules-                    )--  describe "aggregate scalar diagnostics" $ do-    it "reports unsupported shapes, invalid initials, and mismatched guards at stable lines" $ do-      diagnostics <- diagnosticsOf "test/fixtures/aggregate-scalars-unsupported.keiro"-      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- diagnostics, (.severity) diagnostic == Error]-        `shouldBe` [ (AggregateRegisterInitialInvalid, 6),-                     (AggregateRegisterInitialInvalid, 7),-                     (AggregateTypeUnsupportedAtUse, 10),-                     (AggregateExpressionOperandTypeMismatch, 14)-                   ]-      map (.message) diagnostics `shouldSatisfy` any (T.isInfixOf "non-negative integral literals")-      map (.message) diagnostics `shouldSatisfy` any (T.isInfixOf "ISO-8601 UTC timestamps")-      map (.message) diagnostics `shouldSatisfy` any (T.isInfixOf "mapped structural declaration")-    it "accepts Natural aggregate arithmetic in the stable language" $ do-      diagnostics <- diagnosticsOf "test/fixtures/aggregate-scalars-arithmetic.keiro"-      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- diagnostics, (.severity) diagnostic == Error]-        `shouldBe` []-    it "covers unknown, container, fractional, out-of-range, and ordering failures" $ do-      diagnostics <- diagnosticsOf "test/fixtures/aggregate-scalars-invalid-capabilities.keiro"-      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- diagnostics, (.severity) diagnostic == Error]-        `shouldBe` [ (AggregateRegisterInitialInvalid, 6),-                     (AggregateRegisterInitialInvalid, 7),-                     (AggregateTypeUnknown, 10),-                     (AggregateTypeUnsupportedAtUse, 10),-                     (AggregateTypeUnsupportedAtUse, 10),-                     (AggregateTypeUnsupportedAtUse, 10),-                     (AggregateExpressionOperatorUnsupported, 13)-                   ]-    it "keeps one-member workspace diagnostics identical to the single file" $ do-      direct <- diagnosticsOf "test/fixtures/aggregate-scalars-unsupported.keiro"-      composed <- shouldComposeWorkspace "test/fixtures/aggregate-scalars-workspace/service.keiro-workspace"-      let directErrors =-            [((.code) diagnostic, (.line) diagnostic, (.message) diagnostic) | diagnostic <- direct, (.severity) diagnostic == Error]-          workspaceErrors =-            [ ((.code) diagnostic, (.line) (NE.head ((.locations) diagnostic)), (.message) diagnostic)-            | diagnostic <- checkWorkspace composed,-              (.severity) diagnostic == Error-            ]-      workspaceErrors `shouldBe` directErrors--  describe "mapped type graph (EP-149)" $ do-    it "resolves checked declarations, transitive reachability, and every aggregate root path" $ do-      source <- TIO.readFile "test/fixtures/consumer-types.keiro"-      spec <- parseInlineSpec "test/fixtures/consumer-types.keiro" source-      graph <- shouldResolveTypeGraph spec-      Map.size ((.declarations) graph) `shouldBe` 4-      Map.lookup (MappedKey "ArtifactInfo") ((.reachability) graph)-        `shouldBe` Just (Set.fromList [MappedKey "ArtifactKind", MappedKey "ArtifactLocation"])-      map renderUsePath (usePaths graph "ArtifactLocation")-        `shouldBe` [ "Catalog command ObserveArtifact .artifact : ArtifactInfo .location : ArtifactLocation",-                     "Catalog event ArtifactObserved .artifact : ArtifactInfo .location : ArtifactLocation",-                     "Catalog register currentArtifact : ArtifactInfo .location : ArtifactLocation"-                   ]-    it "resolves every builtin through the complete expression algebra" $ do-      source <- TIO.readFile "test/fixtures/consumer-types.keiro"-      spec <- parseInlineSpec "test/fixtures/consumer-types.keiro" source-      graph <- shouldResolveTypeGraph spec-      case Map.lookup (MappedKey "ArtifactInfo") ((.declarations) graph) of-        Just (ResolvedStructural _ (RRecord _ _ fields)) ->-          Set.fromList (concatMap (foldTypeExpr expressionTags . (.valueType)) fields)-            `shouldBe` Set.fromList ["text", "int", "bool", "natural", "time", "json", "optional", "list", "map", "ref:ArtifactKind", "ref:ArtifactLocation"]-        declaration -> expectationFailure ("unexpected ArtifactInfo declaration: " <> show declaration)-    it "rejects direct, mutual, wrapped, and union-arm recursion" $ do-      let direct = mappedSpec [completeStructural "A" (recordShape [TRef "A"])]-          mutual = mappedSpec [completeStructural "A" (recordShape [TRef "B"]), completeStructural "B" (recordShape [TRef "A"])]-          wrapped = mappedSpec [completeStructural "A" (recordShape [TList (TOptional (TRef "A"))])]-          throughArm = mappedSpec [completeStructural "A" (ShapeUnion (TaggedObject "tag" "contents" RejectUnknown) [WireArm "Again" "again" (Just (TRef "A")) noLoc])]-      map (hasTypeGraphError isRecursive . resolveTypeGraph) [direct, mutual, wrapped, throughArm]-        `shouldBe` replicate 4 True-    it "keeps existing ids and enums outside the mapped-reference namespace" $ do-      let spec =-            (mappedSpec [completeStructural "A" (recordShape [TRef "ExistingId"])])-              { ids = [IdDecl "ExistingId" "id" Nothing noLoc]-              }-      resolveTypeGraph spec `shouldSatisfy` hasTypeGraphError isUnresolved-    it "fingerprints wire identity while ignoring Haskell selector names" $ do-      source <- TIO.readFile "test/fixtures/consumer-types.keiro"-      base <- parseInlineSpec "test/fixtures/consumer-types.keiro" source-      baseGraph <- shouldResolveTypeGraph base-      haskellRenameGraph <- shouldResolveTypeGraph (mapArtifactField (wireFieldWithHaskell "renamedKey") base)-      wireRenameGraph <- shouldResolveTypeGraph (mapArtifactField (wireFieldWithKey "renamed_key") base)-      wireFingerprint haskellRenameGraph "ArtifactInfo" `shouldBe` wireFingerprint baseGraph "ArtifactInfo"-      wireFingerprint wireRenameGraph "ArtifactInfo" `shouldNotBe` wireFingerprint baseGraph "ArtifactInfo"--  describe "semantic impact" $ do-    it "derives local aggregate closures and a complete service inventory" $ do-      source <- readTestText "test/fixtures/semantic-impact.keiro"-      spec <- parseInlineSpec "test/fixtures/semantic-impact.keiro" source-      graph <- shouldResolveTypeGraph spec-      let impact = semanticImpact graph-      aggregateMappedClosure impact "Alpha"-        `shouldBe` map MappedKey ["CommandPayload", "EventPayload", "NestedPayload", "RegisterPayload", "SharedPayload"]-      aggregateMappedClosure impact "Beta"-        `shouldBe` [MappedKey "SharedPayload"]-      mappedDeclarationConsumers impact (MappedKey "NestedPayload")-        `shouldBe` [AggregateConsumer "Alpha"]-      mappedDeclarationConsumers impact (MappedKey "SharedPayload")-        `shouldBe` [AggregateConsumer "Alpha", AggregateConsumer "Beta"]-      mappedDeclarationConsumers impact (MappedKey "UnusedPayload")-        `shouldBe` []-      Map.lookup (MappedKey "UnusedPayload") ((.declarationConsumers) impact)-        `shouldBe` Just Set.empty-      serviceMappedInventory impact-        `shouldBe` map MappedKey ["CommandPayload", "EventPayload", "NestedPayload", "RegisterPayload", "SharedPayload", "UnusedPayload"]-    it "folds command, private-event, and register roots explicitly" $ do-      source <- readTestText "test/fixtures/semantic-impact.keiro"-      spec <- parseInlineSpec "test/fixtures/semantic-impact.keiro" source-      impact <- semanticImpact <$> shouldResolveTypeGraph spec-      map (.kind) (aggregateMappedRoots impact "Alpha")-        `shouldBe` [MappedCommandFieldRoot, MappedCommandFieldRoot, MappedEventFieldRoot, MappedRegisterRoot]-      map (.kind) (aggregateMappedRoots impact "Beta")-        `shouldBe` [MappedRegisterRoot]-    it "is independent of declaration and aggregate traversal order" $ do-      source <- readTestText "test/fixtures/semantic-impact.keiro"-      spec <- parseInlineSpec "test/fixtures/semantic-impact.keiro" source-      baseline <- semanticImpact <$> shouldResolveTypeGraph spec-      reordered <--        semanticImpact-          <$> shouldResolveTypeGraph-            spec-              { mapped = reverse ((.mapped) spec),-                nodes = reverse ((.nodes) spec)-              }-      reordered `shouldBe` baseline-    it "keeps future UseSite roots behind an exhaustive compile-time fold" $ do-      source <- readTestText "src/Keiro/Dsl/SemanticImpact.hs"-      source `shouldSatisfy` T.isInfixOf "{-# OPTIONS_GHC -Werror=incomplete-patterns #-}"-      map-        (`T.isInfixOf` source)-        [ "mappedRootFromUseSite site@(RootCommandField",-          "mappedRootFromUseSite site@(RootEventField",-          "mappedRootFromUseSite site@(RootRegister",-          "mappedRootFromUseSite site@(RootWorkqueueField",-          "mappedRootFromUseSite site@(RootReadModelQueryInput",-          "mappedRootFromUseSite site@(RootReadModelQueryResult"-        ]-        `shouldBe` replicate 6 True-      source `shouldSatisfy` (not . T.isInfixOf "mappedRootFromUseSite _")-    it "round-trips canonical snapshots and reports only checked consumer membership changes" $ do-      spec <- specOf "test/fixtures/semantic-impact.keiro"-      snapshot <- semanticImpactSnapshot . semanticImpact <$> shouldResolveTypeGraph spec-      Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot-      let shared = MappedKey "SharedPayload"-          changed =-            snapshot-              { mappedConsumers =-                  Map.adjust (Set.delete (AggregateConsumer "Beta")) shared ((.mappedConsumers) snapshot)-              }-      case diffSemanticImpact snapshot changed of-        [delta] -> do-          (.declaration) delta `shouldBe` shared-          (.previousConsumers) delta `shouldBe` Set.fromList [AggregateConsumer "Alpha", AggregateConsumer "Beta"]-          (.currentConsumers) delta `shouldBe` Set.singleton (AggregateConsumer "Alpha")-          (.serviceConformance) delta `shouldBe` True-        deltas -> expectationFailure ("expected one semantic-impact delta, got " <> show deltas)-      case mappedImpactForDeclarations [MappedKey "NestedPayload"] snapshot snapshot of-        [delta] -> do-          (.declaration) delta `shouldBe` MappedKey "NestedPayload"-          (.previousConsumers) delta `shouldBe` Set.singleton (AggregateConsumer "Alpha")-          (.currentConsumers) delta `shouldBe` Set.singleton (AggregateConsumer "Alpha")-          (.previousEvidence) delta `shouldSatisfy` maybe False (not . Set.null)-          (.currentConsequences) delta `shouldSatisfy` maybe False (not . Set.null)-        deltas -> expectationFailure ("expected one nested semantic-impact delta, got " <> show deltas)-    it "round-trips additive semantic impact ledger rows and rejects known-row corruption" $ do-      spec <- specOf "test/fixtures/semantic-impact.keiro"-      let snapshot = semanticImpactSnapshotForSpec spec-          singleRecord =-            ScaffoldRecord-              { specPath = "semantic-impact.keiro",-                moduleRoot = "",-                layout = "prefixed",-                sourceLanguage = LegacyUnversioned,-                languageContract = effectiveLanguageContract LegacyUnversioned,-                namingEdition = IdiomaticNamingV1,-                moduleRoles = [],-                files = [],-                mappings = [],-                idDomains = [],-                nominalEqualities = [],-                bindingObligations = [],-                behaviorRequirements = [],-                projectionCatalogFacts = [],-                queryContractBaseline = True,-                queryContracts = either (const []) id (queryContractIdentities spec),-                routerSelections = [],-                semanticImpact = Just snapshot-              }-          encoded = renderRecord singleRecord-          semanticRows = filter ("semantic-impact " `T.isPrefixOf`) (T.lines encoded)-          legacyEncoded = T.unlines (filter (not . T.isPrefixOf "semantic-impact ") (T.lines encoded))-          futureEncoded = T.replace "semantic-impact {" "semantic-impact {\"future\":true," encoded-          emptyIdentitySnapshot =-            SemanticImpactSnapshot-              { mappedConsumers = snapshot.mappedConsumers,-                mappedEvidence = snapshot.mappedEvidence,-                mappedConsequences = snapshot.mappedConsequences,-                serviceInventory = snapshot.serviceInventory,-                declarationIdentities = Map.adjust (const "") (MappedKey "CommandPayload") snapshot.declarationIdentities-              }-      length semanticRows `shouldBe` 1-      parseRecord encoded `shouldBe` Just singleRecord-      (.semanticImpact) <$> parseRecord legacyEncoded `shouldBe` Just Nothing-      parseRecord futureEncoded `shouldBe` Just singleRecord-      (Aeson.decode (Aeson.encode emptyIdentitySnapshot) :: Maybe SemanticImpactSnapshot) `shouldBe` Nothing-      case semanticRows of-        [row] -> do-          parseRecord (encoded <> row <> "\n") `shouldBe` Nothing-          let duplicateConsumer = T.replace "\"consumers\":[\"Alpha\",\"Beta\"]" "\"consumers\":[\"Alpha\",\"Alpha\"]" encoded-          duplicateConsumer `shouldNotBe` encoded-          parseRecord duplicateConsumer `shouldBe` Nothing-        _ -> expectationFailure "expected exactly one semantic-impact row"-      workspace <- shouldComposeWorkspace canonicalWorkspacePath-      let workspaceRecord = (sampleWorkspaceRecord workspace) {WorkspaceRecord.semanticImpact = Just snapshot}-          workspaceEncoded = renderWorkspaceRecord workspaceRecord-      T.count "semantic-impact " workspaceEncoded `shouldBe` 1-      parseWorkspaceRecord workspaceEncoded `shouldBe` Just workspaceRecord-      parseWorkspaceRecord (workspaceEncoded <> "future-row ignored\n") `shouldBe` Just workspaceRecord--  describe "string literal integrity" $ do-    it "parses an escaped emit-map value as exactly one row" $ do-      let src =-            T.unlines-              [ "context svc",-                "",-                "emit e {",-                "  contract c",-                "  topic events",-                "  source \"svc\"",-                "  key thingId",-                "  map status {",-                "    \"a\\\" => Wat \\\"b\" => ThingAccepted",-                "    _ => skip",-                "  }",-                "  messageId derive hole",-                "  idempotencyKey derive hole",-                "}"-              ]-      case parseSpec "<escaped-map>" src of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> case [row | NEmit e <- (.nodes) spec, row <- e.map] of-          [row] -> do-            (.value) row `shouldBe` "a\" => Wat \"b"-            (.event) row `shouldBe` "ThingAccepted"-          rows -> expectationFailure ("expected one emit-map row, got " <> show (length rows))-    it "rejects a raw newline inside a quoted string" $ do-      let src = "context svc\n\ncontract c {\n  schemaVersion 1\n  discriminator kind\n  topic events \"first\nsecond\"\n}\n"-      parseSpec "<raw-newline>" src `shouldSatisfy` leftContains "unescaped newline"-    it "rejects an unknown escape sequence" $ do-      let src = "context svc\n\ncontract c {\n  schemaVersion 1\n  discriminator kind\n  topic events \"bad\\q\"\n}\n"-      parseSpec "<unknown-escape>" src `shouldSatisfy` leftContains "unknown escape"-    it "round-trips adversarial text through topics, emit maps, and quoted bindings" $-      property $-        forAll genAdversarialText $ \t ->-          let spec = escapedSpec t-              rendered = renderSpec spec-           in counterexample (T.unpack rendered) (parseSpec "<escaped-round-trip>" rendered === Right spec)--  describe "partial status maps" $ do-    it "suppresses totality only when the partial marker is present" $ do-      partial <- parseInlineSpec "<partial-status-map>" (statusMapSpec " partial")-      totalSpec <- parseInlineSpec "<total-status-map>" (statusMapSpec "")-      map (.code) (validateSpec partial) `shouldNotContain` [StatusMapNotTotal]-      map (.code) (validateSpec totalSpec) `shouldContain` [StatusMapNotTotal]-      parseSpec "<partial-round-trip>" (renderSpec partial) `shouldBe` Right partial--  describe "positioned parser diagnostics" $ do-    it "rejects a duplicate goto at the second clause" $ do-      err <- parseErrorOf "<duplicate-goto>" duplicateGotoSpec-      err `shouldSatisfy` T.isInfixOf "duplicate goto"-      err `shouldSatisfy` T.isInfixOf "<duplicate-goto>:10:"-    it "rejects duplicate wire and projection blocks at their second occurrences" $ do-      wireErr <- parseErrorOf "<duplicate-wire>" duplicateWireSpec-      wireErr `shouldSatisfy` T.isInfixOf "duplicate wire block"-      wireErr `shouldSatisfy` T.isInfixOf "<duplicate-wire>:8:"-      projectionErr <- parseErrorOf "<duplicate-projection>" duplicateProjectionSpec-      projectionErr `shouldSatisfy` T.isInfixOf "duplicate projection block"-      projectionErr `shouldSatisfy` T.isInfixOf "<duplicate-projection>:9:"-    it "anchors a missing goto on the transition line" $ do-      err <- parseErrorOf "<missing-goto>" missingGotoSpec-      err `shouldSatisfy` T.isInfixOf "missing a goto clause"-      err `shouldSatisfy` T.isInfixOf "<missing-goto>:8:"-    it "stops before a misplaced dispatch-id and expects schedule at its start" $ do-      let src = misplacedDispatchIdSpec-          expectedPosition =-            "<misplaced-dispatch-id>:"-              <> T.pack (show (lineNumberContaining "dispatch-id" src))-              <> ":5:"-      err <- parseErrorOf "<misplaced-dispatch-id>" src-      err `shouldSatisfy` T.isInfixOf "schedule"-      err `shouldSatisfy` T.isInfixOf expectedPosition-    it "keeps a malformed register declaration's equals error" $ do-      err <- parseErrorOf "<malformed-register>" malformedRegisterSpec-      err `shouldSatisfy` T.isInfixOf "expecting '='"--  describe "bounded decimal literals" $ do-    forM_ decimalOverflowSpecs $ \(site, src) ->-      it ("rejects overflow at " <> site) $ do-        err <- parseErrorOf ("<overflow-" <> site <> ">") src-        err `shouldSatisfy` T.isInfixOf ("decimal literal " <> decimalOverflow <> " is out of range")-    it "accepts maxBound without changing its value" $ do-      spec <- parseInlineSpec "<max-bound>" (wireDecimalSpec (T.pack (show (maxBound :: Int))))-      [wire.schemaVersion | NAggregate aggregate <- (.nodes) spec, Just wire <- [(.wire) aggregate]]-        `shouldBe` [maxBound]--  describe "identifier hygiene" $ do-    it "normalizes lowercase logical type names and reports generated Haskell keywords at their owning declarations" $ do-      spec <- parseInlineSpec "<identifier-hygiene>" identifierHygieneSpec-      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- validateSpec spec, (.code) diagnostic `elem` [IdentUnsafeNormalization, GeneratedOccurrenceReserved]]-        `shouldBe` [(GeneratedOccurrenceReserved, 7)]-    it "rejects generated vertex constructors that collide with event constructors" $ do-      spec <- parseInlineSpec "<vertex-collision>" vertexCollisionSpec-      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- validateSpec spec, (.code) diagnostic == VertexCtorCollision]-        `shouldBe` [(VertexCtorCollision, 3)]-    it "rejects underscore-leading names whose normalization would erase a word boundary" $ do-      spec <- parseInlineSpec "<underscore-node>" underscoreNodeSpec-      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- validateSpec spec, (.code) diagnostic == IdentUnsafeNormalization]-        `shouldBe` [(IdentUnsafeNormalization, 3)]-    it "rejects normalized module collisions with both source locations" $ do-      spec <- parseInlineSpec "<normalized-collision>" normalizedCollisionSpec-      case [diagnostic | diagnostic <- validateSpec spec, (.code) diagnostic == GeneratedOccurrenceCollision] of-        [diagnostic] -> do-          (.line) diagnostic `shouldBe` 8-          (.relatedLocations) diagnostic `shouldBe` [(3, "'fooBar' also normalizes here")]-          renderDiagnostic "<normalized-collision>" diagnostic `shouldSatisfy` T.isInfixOf "fooBar"-        diagnostics -> expectationFailure ("expected one normalized collision, got " <> show diagnostics)-    it "validates explicit selectors and detects selector collisions in aggregate and contract records" $ do-      service <--        checkedServiceFromText-          "<field-selector-validation>"-          ( T.unlines-              [ "language keiro-dsl 4",-                "context aliases",-                "aggregate Order",-                "  regs",-                "  states Open",-                "  command Change {",-                "    first haskell shared:Text",-                "    second haskell shared:Text",-                "    reserved haskell type:Text",-                "    invalid haskell Bad:Text",-                "  }",-                "contract publicOrder {",-                "  schemaVersion 1",-                "  discriminator kind",-                "  topic changes \"orders.v1\"",-                "  event Changed on changes {",-                "    first haskell duplicate: text",-                "    second haskell duplicate: text",-                "  }",-                "}"-              ]-          )-      let diagnostics = validateService service-          selectorCollisions = [diagnostic | diagnostic <- diagnostics, (.code) diagnostic == GeneratedOccurrenceCollision]-      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- diagnostics, (.code) diagnostic `elem` [GeneratedOccurrenceReserved, IdentUnsafeNormalization]]-        `shouldBe` [(GeneratedOccurrenceReserved, 9), (IdentUnsafeNormalization, 10)]-      map (.line) selectorCollisions `shouldBe` [8, 18]-      map (.relatedLocations) selectorCollisions-        `shouldBe` [ [(7, "'first' also normalizes here")],-                     [(17, "'first' also normalizes here")]-                   ]-    it "rejects empty, duplicate, and envelope-colliding resolved wire keys with field-local evidence" $ do-      service <--        checkedServiceFromText-          "<field-wire-validation>"-          ( T.unlines-              [ "language keiro-dsl 4",-                "context aliases",-                "aggregate Order",-                "  regs",-                "  states Open",-                "  command Change {",-                "    first as \"same\":Text",-                "    second as \"same\":Text",-                "    empty as \"\":Text",-                "  }",-                "  event Changed { value as \"kind\":Text }",-                "contract publicOrder {",-                "  schemaVersion 1",-                "  discriminator kind",-                "  topic changes \"orders.v1\"",-                "  event Published on changes { value as \"kind\": text }",-                "}"-              ]-          )-      let diagnostics = validateService service-          wireDiagnostics = [diagnostic | diagnostic <- diagnostics, (.code) diagnostic `elem` [FieldWireKeyCollision, FieldWireKeyInvalid]]-      map (\diagnostic -> ((.code) diagnostic, (.line) diagnostic)) wireDiagnostics-        `shouldBe` [ (FieldWireKeyCollision, 8),-                     (FieldWireKeyInvalid, 9),-                     (FieldWireKeyCollision, 11),-                     (FieldWireKeyCollision, 16)-                   ]-      case wireDiagnostics of-        firstDiagnostic : _ -> (.relatedLocations) firstDiagnostic `shouldBe` [(7, "wire key 'same' is first declared here")]-        [] -> expectationFailure "expected resolved wire-key diagnostics"-    -- `family` is a contextual keyword GHC accepts as a term under the-    -- advertised GHC2024 contract, and it is the field mori's project signals-    -- are keyed by. This fixture pins that scenario end to end; before ExecPlan-    -- 199 no test referenced it, so the guarantee was untested.-    it "keeps a reserved-word-adjacent contract field intact from check to codec" $-      withTempDirectory "keiro-dsl-reserved-family" $ \out -> do-        let fixture = "test/fixtures/contract-reserved-family.keiro"-        (checkCode, checkOut, checkErr) <- runKeiroDsl ["check", fixture, "--min-language", "4", "--deny-warnings"]-        unless (checkCode == ExitSuccess) (expectationFailure (checkOut <> checkErr))-        checkOut `shouldBe` "OK\n"-        checkErr `shouldNotContain` "warning["--        (scaffoldCode, scaffoldOut, scaffoldErr) <- runKeiroDsl ["scaffold", fixture, "--out", out]-        unless (scaffoldCode == ExitSuccess) (expectationFailure (scaffoldOut <> scaffoldErr))-        tree <- treeSnapshot out-        case [text | (path, text) <- tree, "Contract.hs" `T.isSuffixOf` T.pack path] of-          codec : _ -> do-            -- The DSL name is the record selector …-            codec `shouldSatisfy` T.isInfixOf "family ::"-            -- … and, unaliased, the wire key is the same bytes.-            codec `shouldSatisfy` T.isInfixOf "\"family\""-            codec `shouldNotSatisfy` T.isInfixOf "family_"-          [] -> expectationFailure ("no generated contract module in " <> show (map fst tree))--    -- An alias exists to preserve a brownfield key the current convention would-    -- reject, so its *style* is deliberately not checked (ADR 0021). What is-    -- checked is that the key can be a key: a trailing space or a control-    -- character ships a permanently mis-keyed public field. See ExecPlan 199.-    it "refuses structurally unusable wire-key aliases without opinionating on style" $ do-      let aliasSpec alias =-            T.unlines-              [ "language keiro-dsl 4",-                "context aliases",-                "aggregate Order",-                "  regs",-                "  states Open",-                "  command Change {",-                "    region as \"" <> alias <> "\":Text",-                "  }"-              ]-          keyDiagnostics source = do-            service <- checkedServiceFromText "<alias-content>" source-            pure [diagnostic | diagnostic <- validateService service, (.code) diagnostic == FieldWireKeyInvalid]--      -- Refused: the wire key is the exact bytes on the wire. Written as the-      -- DSL spells them, so `\\n` here is the source's escape, not Haskell's.-      forM_ ["family ", " family", "family\\n", "fam\\tily", "fam\\rily"] $ \bad -> do-        refused <- keyDiagnostics (aliasSpec bad)-        map (.code) refused `shouldBe` [FieldWireKeyInvalid]-        map (.line) refused `shouldBe` [7]--      -- Accepted: these violate `fields=camelCase` and that is exactly the point-      -- of an alias — the brownfield key is preserved, not corrected.-      forM_ ["region_code", "Region-Code", "REGION.CODE", "r\233gion"] $ \brownfield -> do-        accepted <- keyDiagnostics (aliasSpec brownfield)-        accepted `shouldBe` []--    -- The collision planner must register the selector generation actually-    -- emits. Registering a camelized rendering of the raw name made it claim-    -- `foo_bar` "normalizes to" `fooBar`, which generation never does.-    it "plans field collisions against the emitted selector, not a camelized rendering" $ do-      let recordSpec fields =-            T.unlines-              [ "language keiro-dsl 4",-                "context aliases",-                "aggregate Order",-                "  regs",-                "  states Open",-                "  command Change { " <> fields <> " }"-              ]-          collisionsIn source = do-            service <- checkedServiceFromText "<selector-collision>" source-            pure [diagnostic | diagnostic <- validateService service, (.code) diagnostic == GeneratedOccurrenceCollision]--      -- Distinct emitted selectors: `foo_bar` generates `foo_bar`. It is still-      -- refused, but by the generated-name audit that owns lowerCamelCase — not-      -- by a collision claim naming an unrelated sibling.-      falseCollision <- collisionsIn (recordSpec "foo_bar fooBar")-      falseCollision `shouldBe` []--      -- Two declarations that really do emit one selector still collide.-      realCollision <- collisionsIn (recordSpec "fooBar other haskell fooBar")-      map (.code) realCollision `shouldSatisfy` \codes -> GeneratedOccurrenceCollision `elem` codes--    it "checks copied command selectors in both generated record scopes" $ do-      service <--        checkedServiceFromText-          "<copied-selector-collision>"-          ( T.unlines-              [ "language keiro-dsl 4",-                "context aliases",-                "aggregate Order",-                "  regs",-                "  states Open",-                "  command Change { first haskell shared:Text second haskell shared:Text }",-                "  event Changed = fields(Change)"-              ]-          )-      [(.line) diagnostic | diagnostic <- validateService service, (.code) diagnostic == GeneratedOccurrenceCollision]-        `shouldBe` [6, 6]-    it "anchors repeated reserved contract fields at their own lines and maps them through workspaces" $ do-      service <--        checkedServiceFromText-          "domain/member.keiro"-          ( T.unlines-              [ "language keiro-dsl 4",-                "context aliases",-                "contract publicOrder {",-                "  schemaVersion 1",-                "  discriminator kind",-                "  topic changes \"orders.v1\"",-                "  event First on changes { where: text }",-                "  event Second on changes { where: text }",-                "}"-              ]-          )-      [(.line) diagnostic | diagnostic <- validateService service, (.code) diagnostic == GeneratedOccurrenceReserved]-        `shouldBe` [7, 8]-      let workspaceDiagnostics =-            [ diagnostic-            | diagnostic <- checkWorkspace (oneMemberWorkspace "domain/member.keiro" (checkedSpec service)),-              (.code) diagnostic == GeneratedOccurrenceReserved-            ]-          workspaceLocations =-            [ ((.file) location, (.line) location)-            | diagnostic <- workspaceDiagnostics,-              location <- NE.toList ((.locations) diagnostic)-            ]-      workspaceLocations-        `shouldBe` [ (WorkspaceMemberFile "member.keiro", 7),-                     (WorkspaceMemberFile "member.keiro", 8)-                   ]-    it "rejects non-ASCII identifier characters in the parser" $-      parseSpec "<unicode-identifier>" unicodeIdentifierSpec `shouldSatisfy` leftContains "unexpected"--  describe "Haskell.name-audit" $ do-    it "inventories every declaration in a fresh compound-name scaffold" $ do-      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      let service = legacyCheckedService spec-          ctx = defaultContext (spec.context)-          modules = scaffoldServiceModules ctx service-      concatMap auditGeneratedHaskell modules `shouldBe` []-    it "rejects underscore module and declaration mutations but ignores literals and comments" $ do-      let mutated =-            ScaffoldModule-              { path = "Generated/IncidentPaging/Service_oncall/Mutation.hs",-                text =-                  T.unlines-                    [ "module Generated.IncidentPaging.Service_oncall.Mutation where",-                      "-- comment_value :: Text",-                      "literalValue = \"string_value\"",-                      "render_eventTypes :: Int",-                      "render_eventTypes = 1"-                    ],-                kind = Generated,-                origin = "test name-audit mutation"-              }-          violations = auditGeneratedHaskell mutated-      violations `shouldSatisfy` any (T.isInfixOf "Service_oncall")-      violations `shouldSatisfy` any (T.isInfixOf "render_eventTypes")-      violations `shouldSatisfy` all (not . T.isInfixOf "comment_value")-      violations `shouldSatisfy` all (not . T.isInfixOf "string_value")-    it "rejects repeated generated signatures before writing" $ do-      let mutated =-            ScaffoldModule-              { path = "Generated/Repeated.hs",-                text =-                  T.unlines-                    [ "module Generated.Repeated where",-                      "sameValue :: Bool",-                      "sameValue = True",-                      "sameValue :: Bool",-                      "sameValue = False"-                    ],-                kind = Generated,-                origin = "test repeated declaration"-              }-      auditGeneratedHaskell mutated `shouldSatisfy` any (T.isInfixOf "repeated top-level type signature 'sameValue'")--  describe "Haskell.name-migration" $ do-    it "pairs a legacy module path with its stable idiomatic artifact" $ do-      let currentModule =-            ScaffoldModule-              { path = "Generated/IncidentPaging/ServiceOncall/ReadModel.hs",-                text = "module Generated.IncidentPaging.ServiceOncall.ReadModel where\n",-                kind = Generated,-                origin = "readmodel service_oncall ReadModel"-              }-      planSourceMoves [(Nothing, Generated, "Generated/IncidentPaging/Service_oncall/ReadModel.hs")] [currentModule]-        `shouldBe` Right-          [ SourceMove-              { role = moduleRole currentModule,-                kind = Generated,-                oldModule = "Generated.IncidentPaging.Service_oncall.ReadModel",-                newModule = "Generated.IncidentPaging.ServiceOncall.ReadModel",-                oldPath = "Generated/IncidentPaging/Service_oncall/ReadModel.hs",-                newPath = "Generated/IncidentPaging/ServiceOncall/ReadModel.hs",-                backupPath = ".keiro-dsl-name-migrations/legacy-v1-to-idiomatic-v1/Generated/IncidentPaging/Service_oncall/ReadModel.hs",-                contentDigest = Nothing,-                transformedDigest = Nothing-              }-          ]-    it "rewrites code-token module references while preserving comments and literals" $ do-      let old = "Generated.IncidentPaging.Service_oncall.ReadModel"-          new = "Generated.IncidentPaging.ServiceOncall.ReadModel"-          source =-            T.unlines-              [ "module IncidentPaging.Service_oncall.ReadModelHoles where",-                "import Generated.IncidentPaging.Service_oncall.ReadModel",-                "value = Generated.IncidentPaging.Service_oncall.ReadModel.constructor",-                "-- Generated.IncidentPaging.Service_oncall.ReadModel in a comment",-                "literal = \"Generated.IncidentPaging.Service_oncall.ReadModel\"",-                "character = 'x'",-                "{- outer {- Generated.IncidentPaging.Service_oncall.ReadModel -} comment -}"-              ]-      case rewriteHaskellModuleReferences (Map.singleton old new) source of-        Left err -> expectationFailure (show err)-        Right rewritten -> do-          rewritten `shouldSatisfy` T.isInfixOf "import Generated.IncidentPaging.ServiceOncall.ReadModel"-          rewritten `shouldSatisfy` T.isInfixOf "value = Generated.IncidentPaging.ServiceOncall.ReadModel.constructor"-          rewritten `shouldSatisfy` T.isInfixOf "-- Generated.IncidentPaging.Service_oncall.ReadModel in a comment"-          rewritten `shouldSatisfy` T.isInfixOf "literal = \"Generated.IncidentPaging.Service_oncall.ReadModel\""-          rewritten `shouldSatisfy` T.isInfixOf "{- outer {- Generated.IncidentPaging.Service_oncall.ReadModel -} comment -}"-    it "requires both flags when a legacy ledger needs only sidecar renames" $ do-      withTempDirectory "keiro-dsl-sidecar-only-name-migration" $ \out -> do-        spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-        let service = legacyCheckedService spec-            ctx = defaultContext (spec.context)-        modules <- case planTestServiceScaffold ctx service of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right planned -> pure planned-        initial <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing False False out False "incident-paging.keiro" LegacyUnversioned ctx service modules-        case initial of-          Left refusals -> expectationFailure (show refusals)-          Right _ -> pure ()-        let recordPath = out </> recordFileName (spec.context)-            fragmentPath = out </> contextCabalFragmentFileName (spec.context)-        currentRecord <--          TIO.readFile recordPath >>= \contents ->-            maybe (expectationFailure "fresh scaffold record did not parse" >> fail "unreachable") pure (parseRecord contents)-        TIO.writeFile recordPath (renderRecord (scaffoldRecordWithEdition LegacyNamingV1 currentRecord))-        renameFile recordPath (out </> legacyContextRecordFileName (spec.context))-        renameFile fragmentPath (out </> legacyContextManifestFileName (spec.context))-        nameOnly <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True False out False "incident-paging.keiro" LegacyUnversioned ctx service modules-        nameOnly `shouldSatisfy` \case-          Left [NameMigrationRequired [], GeneratedHaskellEditionRequired impact, SidecarMovesAlreadyApplied sidecars] ->-            (.fromEdition) impact == LegacyNamingV1 && length sidecars == 2-          _ -> False--      withTempDirectory "keiro-dsl-workspace-sidecar-only-name-migration" $ \out -> do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        plan <- shouldPlanWorkspaceSpec workspace-        initial <- executeWorkspaceScaffold out False plan-        case initial of-          Left refusals -> expectationFailure (show refusals)-          Right _ -> pure ()-        let service = (.service) workspace-            recordPath = out </> workspaceRecordFileName service-            fragmentPath = out </> workspaceManifestFileName service-        currentRecord <--          TIO.readFile recordPath >>= \contents ->-            maybe (expectationFailure "fresh workspace record did not parse" >> fail "unreachable") pure (parseWorkspaceRecord contents)-        TIO.writeFile recordPath (renderWorkspaceRecord (workspaceRecordWithEditionAndModules LegacyNamingV1 currentRecord.modules currentRecord))-        renameFile recordPath (out </> legacyWorkspaceRecordFileName service)-        renameFile fragmentPath (out </> legacyWorkspaceManifestFileName service)-        nameOnly <- executeWorkspaceScaffoldWithMigrations out False True False plan-        nameOnly `shouldSatisfy` \case-          Left [NameMigrationRequired [], GeneratedHaskellEditionRequired impact, SidecarMovesAlreadyApplied sidecars] ->-            (.fromEdition) impact == LegacyNamingV1 && length sidecars == 2-          _ -> False-    it "refuses without mutation, then applies recoverable generated and hole moves" $-      withTempDirectory "keiro-dsl-name-migration" $ \out -> do-        spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-        let service = legacyCheckedService spec-            ctx = defaultContext (spec.context)-        modules <- case planTestServiceScaffold ctx service of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right planned -> pure planned-        let selected =-              [ scaffoldModule-              | scaffoldModule <- modules,-                any (`T.isSuffixOf` T.pack ((.path) scaffoldModule)) ["ServiceOncall/ReadModel.hs", "ServiceOncall/ReadModelHoles.hs"]-              ]-            legacyPath = T.unpack . T.replace "ServiceOncall" "Service_oncall" . T.pack-            reverseModules =-              Map.fromList-                [ (moduleNameFromPath ((.path) scaffoldModule), moduleNameFromPath (legacyPath ((.path) scaffoldModule)))-                | scaffoldModule <- selected-                ]-        forM_ selected $ \scaffoldModule -> do-          legacyText <- case rewriteHaskellModuleReferences reverseModules ((.text) scaffoldModule) of-            Left err -> expectationFailure (show err) >> fail "unreachable"-            Right source -> pure source-          let oldPath = out </> legacyPath ((.path) scaffoldModule)-              withEvidence-                | (.kind) scaffoldModule == HoleStub =-                    legacyText-                      <> "\n-- Generated.IncidentPaging.Service_oncall.ReadModel remains in this comment\n"-                      <> "migrationLiteral = \"Generated.IncidentPaging.Service_oncall.ReadModel\"\n"-                | otherwise = legacyText-          createDirectoryIfMissing True (takeDirectory oldPath)-          TIO.writeFile oldPath withEvidence-        let legacyRecord =-              ScaffoldRecord-                { specPath = "incident-paging.keiro",-                  moduleRoot = "",-                  layout = "prefixed",-                  sourceLanguage = LegacyUnversioned,-                  languageContract = effectiveLanguageContract LegacyUnversioned,-                  namingEdition = LegacyNamingV1,-                  moduleRoles = [],-                  files = [((.kind) scaffoldModule, legacyPath ((.path) scaffoldModule)) | scaffoldModule <- selected],-                  mappings = [],-                  idDomains = [],-                  nominalEqualities = [],-                  bindingObligations = [],-                  behaviorRequirements = [],-                  projectionCatalogFacts = [],-                  queryContractBaseline = False,-                  queryContracts = [],-                  routerSelections = [],-                  semanticImpact = Nothing-                }-            recordPath = out </> recordFileName (spec.context)-        TIO.writeFile recordPath (renderRecord legacyRecord)-        let currentFragment = out </> contextCabalFragmentFileName (spec.context)-            legacyRecordPath = out </> legacyContextRecordFileName (spec.context)-            legacyFragmentPath = out </> legacyContextManifestFileName (spec.context)-        TIO.writeFile currentFragment "legacy cabal fragment\n"-        renameFile recordPath legacyRecordPath-        renameFile currentFragment legacyFragmentPath-        beforeMigration <- treeSnapshot out-        refused <- executeServiceScaffoldWithRuntimePackageAndNameMigrations Nothing False out False "incident-paging.keiro" LegacyUnversioned ctx service modules-        refused `shouldSatisfy` \case-          Left [SidecarMigrationRequired sidecars, GeneratedHaskellEditionRequired impact] ->-            length sidecars == 2 && (.fromEdition) impact == LegacyNamingV1-          _ -> False-        renderRefusals (either id (const []) refused)-          `shouldSatisfy` any (T.isInfixOf "needs both --apply-name-migrations and --apply-generated-haskell-edition")-        treeSnapshot out `shouldReturn` beforeMigration--        nameOnly <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True False out False "incident-paging.keiro" LegacyUnversioned ctx service modules-        nameOnly `shouldSatisfy` \case-          Left [NameMigrationRequired moves, GeneratedHaskellEditionRequired impact, SidecarMovesAlreadyApplied sidecars] ->-            length moves == 2-              && all ((/= Nothing) . (.contentDigest)) moves-              && all ((/= Nothing) . (.transformedDigest)) moves-              && (.fromEdition) impact == LegacyNamingV1-              && length sidecars == 2-          _ -> False-        applied <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True True out False "incident-paging.keiro" LegacyUnversioned ctx service modules-        report <- case applied of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right value -> pure value-        length ((.nameMoves) report) `shouldBe` 2-        let editionBackupRoot = out </> ".keiro-dsl-generated-haskell-migrations/legacy-v1-to-idiomatic-v2"-        doesFileExist (editionBackupRoot </> recordFileName (spec.context)) `shouldReturn` True-        doesFileExist (editionBackupRoot </> contextCabalFragmentFileName (spec.context)) `shouldReturn` True-        remediation <- TIO.readFile (editionBackupRoot </> "remediation-report.txt")-        remediation `shouldSatisfy` T.isInfixOf "source-moves: 2"-        remediation `shouldSatisfy` T.isInfixOf "Service_oncall/ReadModel.hs -> Generated/IncidentPaging/ServiceOncall/ReadModel.hs"-        let newHole = out </> "IncidentPaging/ServiceOncall/ReadModelHoles.hs"-            oldHole = out </> "IncidentPaging/Service_oncall/ReadModelHoles.hs"-            backupHole = out </> ".keiro-dsl-name-migrations/legacy-v1-to-idiomatic-v1/IncidentPaging/Service_oncall/ReadModelHoles.hs"-        doesFileExist oldHole `shouldReturn` False-        doesFileExist newHole `shouldReturn` True-        doesFileExist backupHole `shouldReturn` True-        migratedHole <- TIO.readFile newHole-        migratedHole `shouldSatisfy` T.isInfixOf "module IncidentPaging.ServiceOncall.ReadModelHoles"-        migratedHole `shouldSatisfy` T.isInfixOf "-- Generated.IncidentPaging.Service_oncall.ReadModel remains in this comment"-        migratedHole `shouldSatisfy` T.isInfixOf "migrationLiteral = \"Generated.IncidentPaging.Service_oncall.ReadModel\""-        backupBefore <- TIO.readFile backupHole-        rerun <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True True out False "incident-paging.keiro" LegacyUnversioned ctx service modules-        case rerun of-          Left refusals -> expectationFailure (show refusals)-          Right rerunReport -> (.nameMoves) rerunReport `shouldBe` []-        TIO.readFile backupHole `shouldReturn` backupBefore-        -- Recreate the exact crash state after every backup and prepared file-        -- exists but before any destination is installed. A corrupted prepared-        -- file refuses; restoring its digest lets the next run resume.-        preparedSnapshots <- forM selected $ \scaffoldModule -> do-          let newPath = out </> (.path) scaffoldModule-              preparedPath = newPath <> ".keiro-dsl-name-migration-prepared"-          bytes <- TIO.readFile newPath-          renameFile newPath preparedPath-          pure (preparedPath, bytes)-        -- This is specifically the name-move crash state. Keep the ledger at-        -- the current presentation edition so the independent edition-backup-        -- conflict gate does not mask the prepared-source digest check.-        TIO.writeFile recordPath (renderRecord (scaffoldRecordWithEdition IdiomaticNamingV2 legacyRecord))-        case preparedSnapshots of-          (firstPrepared, firstBytes) : _ -> TIO.writeFile firstPrepared (firstBytes <> "\ncorrupt")-          [] -> expectationFailure "expected prepared migration sources"-        conflicted <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True True out False "incident-paging.keiro" LegacyUnversioned ctx service modules-        conflicted `shouldSatisfy` \case Left [NameMigrationRefusal messages] -> any (T.isInfixOf "prepared source digest") messages; _ -> False-        forM_ preparedSnapshots (uncurry TIO.writeFile)-        resumed <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True True out False "incident-paging.keiro" LegacyUnversioned ctx service modules-        case resumed of-          Left refusals -> expectationFailure (show refusals)-          Right resumedReport -> length ((.nameMoves) resumedReport) `shouldBe` 2-        doesFileExist newHole `shouldReturn` True-        TIO.readFile backupHole `shouldReturn` backupBefore-    it "applies the same move protocol to a two-member workspace without changing ownership" $-      withTempDirectory "keiro-dsl-workspace-name-migration" $ \out -> do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        plan <- shouldPlanWorkspaceSpec workspace-        initial <- executeWorkspaceScaffold out False plan-        case initial of-          Left refusals -> expectationFailure (show refusals)-          Right _ -> pure ()-        let recordPath = out </> workspaceRecordFileName ((.service) workspace)-        currentRecord <--          TIO.readFile recordPath >>= \contents ->-            maybe (expectationFailure "fresh workspace record did not parse" >> fail "unreachable") pure (parseWorkspaceRecord contents)-        let selectedRows = [row | row <- (.modules) currentRecord, "ProjectActivity" `T.isInfixOf` T.pack ((.path) row)]-            legacyPath = T.unpack . T.replace "ProjectActivity" "Project_activity" . T.pack-            reverseModules =-              Map.fromList-                [ (moduleNameFromPath ((.path) row), moduleNameFromPath (legacyPath ((.path) row)))-                | row <- selectedRows-                ]-        selectedRows `shouldSatisfy` (not . null)-        forM_ selectedRows $ \row -> do-          currentSource <- TIO.readFile (out </> (.path) row)-          legacySource <- case rewriteHaskellModuleReferences reverseModules currentSource of-            Left err -> expectationFailure (show err) >> fail "unreachable"-            Right source -> pure source-          writeFileWithParents (out </> legacyPath ((.path) row)) legacySource-          removeFile (out </> (.path) row)-        let legacyRecord =-              workspaceRecordWithEditionAndModules-                LegacyNamingV1-                [ if row `elem` selectedRows then workspaceModuleRowWithPath (legacyPath row.path) row else row-                | row <- currentRecord.modules-                ]-                currentRecord-            ownersBefore = Map.fromList [((.role) row, (.owner) row) | row <- selectedRows]-        TIO.writeFile recordPath (renderWorkspaceRecord legacyRecord)-        let currentFragment = out </> workspaceManifestFileName ((.service) workspace)-            legacyRecordPath = out </> legacyWorkspaceRecordFileName ((.service) workspace)-            legacyFragmentPath = out </> legacyWorkspaceManifestFileName ((.service) workspace)-        renameFile recordPath legacyRecordPath-        renameFile currentFragment legacyFragmentPath-        beforeMigration <- treeSnapshot out-        refused <- executeWorkspaceScaffoldWithNameMigrations out False False plan-        refused `shouldSatisfy` \case-          Left [SidecarMigrationRequired sidecars, GeneratedHaskellEditionRequired impact] ->-            length sidecars == 2 && (.fromEdition) impact == LegacyNamingV1-          _ -> False-        treeSnapshot out `shouldReturn` beforeMigration-        nameOnly <- executeWorkspaceScaffoldWithMigrations out False True False plan-        nameOnly `shouldSatisfy` \case-          Left [NameMigrationRequired moves, GeneratedHaskellEditionRequired impact, SidecarMovesAlreadyApplied sidecars] ->-            length moves == length selectedRows-              && (.fromEdition) impact == LegacyNamingV1-              && length sidecars == 2-          _ -> False-        applied <- executeWorkspaceScaffoldWithMigrations out False True True plan-        report <- case applied of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right value -> pure value-        length ((.nameMoves) report) `shouldBe` length selectedRows-        let editionBackupRoot = out </> ".keiro-dsl-generated-haskell-migrations/legacy-v1-to-idiomatic-v2"-        doesFileExist (editionBackupRoot </> workspaceRecordFileName ((.service) workspace)) `shouldReturn` True-        doesFileExist (editionBackupRoot </> workspaceManifestFileName ((.service) workspace)) `shouldReturn` True-        remediation <- TIO.readFile (editionBackupRoot </> "remediation-report.txt")-        remediation `shouldSatisfy` T.isInfixOf ("source-moves: " <> T.pack (show (length selectedRows)))-        migratedRecord <--          TIO.readFile recordPath >>= \contents ->-            maybe (expectationFailure "migrated workspace record did not parse" >> fail "unreachable") pure (parseWorkspaceRecord contents)-        (.namingEdition) migratedRecord `shouldBe` IdiomaticNamingV2-        let migratedRows = [row | row <- (.modules) migratedRecord, (.role) row `Map.member` ownersBefore]-        Map.fromList [((.role) row, (.owner) row) | row <- migratedRows] `shouldBe` ownersBefore-        map (.path) migratedRows `shouldSatisfy` all (not . T.isInfixOf "Project_activity" . T.pack)-        forM_ selectedRows $ \row -> do-          doesFileExist (out </> legacyPath ((.path) row)) `shouldReturn` False-          doesFileExist (out </> (.path) row) `shouldReturn` True-          doesFileExist (out </> ".keiro-dsl-name-migrations/legacy-v1-to-idiomatic-v1" </> legacyPath ((.path) row)) `shouldReturn` True--  describe "generated Haskell edition migration" $ do-    it "refuses without mutation and adopts idiomatic-v2 with durable backups while preserving Hole bytes" $-      withTempDirectory "keiro-dsl-generated-haskell-edition" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            sourceLanguage = (.sourceLanguage) parsed-        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)-        let runAt applyEdition =-              executeServiceScaffoldWithRuntimePackageAndMigrations-                Nothing-                False-                applyEdition-                out-                False-                "behavior-complete.keiro"-                sourceLanguage-                ctx-                service-                modules-        _ <- runAt False >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        let recordPath = out </> recordFileName (spec.context)-            backupRoot = out </> ".keiro-dsl-generated-haskell-migrations/legacy-v1-to-idiomatic-v2"-        currentRecord <--          TIO.readFile recordPath >>= \contents ->-            maybe (expectationFailure "fresh scaffold record did not parse" >> fail "unreachable") pure (parseRecord contents)-        let legacyRecord = scaffoldRecordWithEdition LegacyNamingV1 currentRecord-            behaviorHole =-              head-                [ out </> (.path) scaffoldModule-                | scaffoldModule <- modules,-                  (.kind) scaffoldModule == HoleStub,-                  "BehaviorHoles.hs" `T.isSuffixOf` T.pack ((.path) scaffoldModule)-                ]-        TIO.writeFile recordPath (renderRecord legacyRecord)-        originalHole <- TIO.readFile behaviorHole-        let legacyHole =-              originalHole-                <> T.unlines-                  [ "",-                    "editionMigrationPrefix f = failureCode f",-                    "editionMigrationQualified f = BC.failureCode f",-                    "editionMigrationDot f = f.failureCode",-                    "editionMigrationField f = f {failureCode = \"x\"}",-                    "editionMigrationOperator fs = failureCode <$> fs",-                    "-- failureCode f",-                    "editionMigrationCurrent f = f.code"-                  ]-        TIO.writeFile behaviorHole legacyHole-        beforeRefusal <- treeSnapshot out-        refused <- runAt False-        refused `shouldSatisfy` \case-          Left [GeneratedHaskellEditionRequired impact] ->-            (.fromEdition) impact == LegacyNamingV1-              && not (null ((.generatedPaths) impact))-              && length ((.sidecarPaths) impact) == 2-              && Set.fromList [((.current) use, (.form) use) | use <- (.handOwnedUses) impact]-                == Set.fromList-                  [ ("failureCode", PrefixApplication),-                    ("failureCode", QualifiedApplication),-                    ("failureCode", RecordDotRenamed),-                    ("failureCode", RecordFieldBinding),-                    ("failureCode", OperatorOperand)-                  ]-          _ -> False-        renderRefusals (either id (const []) refused)-          `shouldSatisfy` \lines' ->-            any (T.isInfixOf "--apply-generated-haskell-edition") lines'-              && any (T.isInfixOf "legacy-v1 -> idiomatic-v2") lines'-        treeSnapshot out `shouldReturn` beforeRefusal--        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        TIO.readFile behaviorHole `shouldReturn` legacyHole-        backupRecord <- TIO.readFile (backupRoot </> recordFileName (spec.context))-        backupRecord `shouldSatisfy` T.isInfixOf "naming-edition legacy-v1"-        adoptedRecord <- TIO.readFile recordPath-        adoptedRecord `shouldSatisfy` T.isInfixOf "naming-edition idiomatic-v2"-        remediation <- TIO.readFile (backupRoot </> "remediation-report.txt")-        remediation `shouldSatisfy` T.isInfixOf "failureCode (PrefixApplication) -> record.code"-        remediation `shouldSatisfy` T.isInfixOf "attributable uses only"--        backedUpFiles <- treeSnapshot backupRoot-        forM_ backedUpFiles $ \(path, contents) ->-          unless (path == "remediation-report.txt") (writeFileWithParents (out </> path) contents)-        TIO.writeFile behaviorHole originalHole-        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        refreshedRemediation <- TIO.readFile (backupRoot </> "remediation-report.txt")-        refreshedRemediation `shouldSatisfy` T.isInfixOf "hand-owned-selector-uses: 0"-        rerun <- runAt False-        case rerun of-          Left failures -> expectationFailure (show failures)-          Right _ -> pure ()-    it "uses the same refusal and backup protocol for a workspace ledger" $-      withTempDirectory "keiro-dsl-workspace-generated-haskell-edition" $ \out -> do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        plan <- shouldPlanWorkspaceSpec workspace-        _ <- executeWorkspaceScaffold out False plan >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        let recordPath = out </> workspaceRecordFileName ((.service) workspace)-            backupRecord =-              out-                </> ".keiro-dsl-generated-haskell-migrations/legacy-v1-to-idiomatic-v2"-                </> workspaceRecordFileName ((.service) workspace)-        currentRecord <- TIO.readFile recordPath-        TIO.writeFile recordPath (T.unlines (filter (not . T.isPrefixOf "naming-edition ") (T.lines currentRecord)))-        beforeRefusal <- treeSnapshot out-        refused <- executeWorkspaceScaffoldWithMigrations out False False False plan-        refused `shouldSatisfy` \case-          Left [GeneratedHaskellEditionRequired impact] ->-            (.fromEdition) impact == LegacyNamingV1 && not (null ((.generatedPaths) impact))-          _ -> False-        treeSnapshot out `shouldReturn` beforeRefusal-        _ <- executeWorkspaceScaffoldWithMigrations out False False True plan >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        backedUp <- TIO.readFile backupRecord-        backedUp `shouldSatisfy` (not . T.isInfixOf "naming-edition ")-        adopted <- TIO.readFile recordPath-        adopted `shouldSatisfy` T.isInfixOf "naming-edition idiomatic-v2"-    it "refuses an unreadable single-spec ledger without changing the tree" $-      withTempDirectory "keiro-dsl-unreadable-ledger" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            sourceLanguage = (.sourceLanguage) parsed-        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)-        let run =-              executeServiceScaffoldWithRuntimePackageAndMigrations-                Nothing-                False-                False-                out-                False-                "behavior-complete.keiro"-                sourceLanguage-                ctx-                service-                modules-            recordPath = out </> recordFileName (spec.context)-        _ <- run >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        TIO.appendFile recordPath "spec: duplicate.keiro\n"-        before <- treeSnapshot out-        run `shouldReturn` Left [LedgerUnreadable recordPath]-        treeSnapshot out `shouldReturn` before-    it "refuses an unreadable workspace ledger without changing the tree" $-      withTempDirectory "keiro-dsl-workspace-unreadable-ledger" $ \out -> do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        plan <- shouldPlanWorkspaceSpec workspace-        _ <- executeWorkspaceScaffold out False plan >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        let recordPath = out </> workspaceRecordFileName ((.service) workspace)-        TIO.appendFile recordPath "service: duplicate\n"-        before <- treeSnapshot out-        executeWorkspaceScaffoldWithMigrations out False False False plan-          `shouldReturn` Left [LedgerUnreadable recordPath]-        treeSnapshot out `shouldReturn` before-    it "refuses a tampered edition backup without changing the tree" $-      withTempDirectory "keiro-dsl-tampered-edition-backup" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            sourceLanguage = (.sourceLanguage) parsed-        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)-        let runAt applyEdition =-              executeServiceScaffoldWithRuntimePackageAndMigrations Nothing False applyEdition out False "behavior-complete.keiro" sourceLanguage ctx service modules-            recordPath = out </> recordFileName (spec.context)-            backupRoot = out </> ".keiro-dsl-generated-haskell-migrations/idiomatic-v1-to-idiomatic-v2"-        _ <- runAt False >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        currentRecord <- TIO.readFile recordPath >>= maybe (fail "fresh record did not parse") pure . parseRecord-        TIO.writeFile recordPath (renderRecord (scaffoldRecordWithEdition IdiomaticNamingV1 currentRecord))-        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        backedUpFiles <- treeSnapshot backupRoot-        forM_ backedUpFiles $ \(path, contents) ->-          unless (path == "remediation-report.txt") (writeFileWithParents (out </> path) contents)-        let generatedBackup =-              head [path | (path, _) <- backedUpFiles, takeExtension path == ".hs"]-        TIO.appendFile (backupRoot </> generatedBackup) "\n-- tampered\n"-        beforeRefusal <- treeSnapshot out-        refused <- runAt True-        refused `shouldSatisfy` \case-          Left [GeneratedHaskellEditionRefusal [reason]] -> T.pack generatedBackup `T.isInfixOf` reason-          _ -> False-        treeSnapshot out `shouldReturn` beforeRefusal-    it "detects an interrupted apply while the ledger is pre-current and recovers after restoring backups" $-      withTempDirectory "keiro-dsl-interrupted-edition-apply" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            sourceLanguage = (.sourceLanguage) parsed-        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)-        let runAt applyEdition =-              executeServiceScaffoldWithRuntimePackageAndMigrations Nothing False applyEdition out False "behavior-complete.keiro" sourceLanguage ctx service modules-            recordRelative = recordFileName (spec.context)-            recordPath = out </> recordRelative-            backupRoot = out </> ".keiro-dsl-generated-haskell-migrations/idiomatic-v1-to-idiomatic-v2"-        _ <- runAt False >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        currentRecord <- TIO.readFile recordPath >>= maybe (fail "fresh record did not parse") pure . parseRecord-        TIO.writeFile recordPath (renderRecord (scaffoldRecordWithEdition IdiomaticNamingV1 currentRecord))-        forM_ [out </> path | (Generated, path) <- (.files) currentRecord] $ \path ->-          TIO.appendFile path "\n-- pre-adoption edition bytes\n"-        initialRefusal <- runAt False-        generatedCount <- case initialRefusal of-          Left [GeneratedHaskellEditionRequired impact] -> pure (length ((.generatedPaths) impact))-          other -> expectationFailure (show other) >> fail "unreachable"-        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        cleanApply <- treeSnapshot out-        -- Conflict detection is active only while the ledger records a-        -- pre-current edition; restoring just that ledger models interruption.-        TIO.readFile (backupRoot </> recordRelative) >>= TIO.writeFile recordPath-        interrupted <- runAt True-        interrupted `shouldSatisfy` \case-          Left [GeneratedHaskellEditionRefusal reasons] ->-            length reasons == generatedCount && all (T.isInfixOf "edition backup conflict") reasons-          _ -> False-        backedUpFiles <- treeSnapshot backupRoot-        forM_ backedUpFiles $ \(path, contents) ->-          unless (path == "remediation-report.txt") (writeFileWithParents (out </> path) contents)-        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        treeSnapshot out `shouldReturn` cleanApply-    it "drives the built CLI through refusal, apply, and idempotent rerun" $-      withTempDirectory "keiro-dsl-edition-cli" $ \out -> do-        let fixture = "test/fixtures/behavior-complete.keiro"-        (initialCode, _, _) <- runKeiroDsl ["scaffold", fixture, "--out", out]-        initialCode `shouldBe` ExitSuccess-        spec <- specOf fixture-        let recordPath = out </> recordFileName (spec.context)-        currentRecord <- TIO.readFile recordPath-        TIO.writeFile recordPath (T.replace "naming-edition idiomatic-v2" "naming-edition idiomatic-v1" currentRecord)-        beforeRefusal <- treeSnapshot out-        (refusalCode, _, refusalError) <- runKeiroDsl ["scaffold", fixture, "--out", out]-        refusalCode `shouldBe` ExitFailure 1-        refusalError `shouldSatisfy` isInfixOf "generated Haskell edition migration required: idiomatic-v1 -> idiomatic-v2"-        treeSnapshot out `shouldReturn` beforeRefusal-        (applyCode, _, _) <- runKeiroDsl ["scaffold", fixture, "--out", out, "--apply-generated-haskell-edition"]-        applyCode `shouldBe` ExitSuccess-        afterApply <- treeSnapshot out-        (rerunCode, _, _) <- runKeiroDsl ["scaffold", fixture, "--out", out, "--apply-generated-haskell-edition"]-        rerunCode `shouldBe` ExitSuccess-        treeSnapshot out `shouldReturn` afterApply--  describe "generated Haskell presentation rewrite" $ do-    it "keeps Template Haskell quotes and promoted ticks in Code" $ do-      modernizeGeneratedHaskellSourceWithState "x = ''Foo\ny = sourceFile r\n"-        `shouldBe` ("x = ''Foo\ny = file r\n", Code)-      modernizeGeneratedHaskellSourceWithState "x = '[]\ny = sourceFile r\n"-        `shouldBe` ("x = '[]\ny = file r\n", Code)-      modernizeGeneratedHaskellSourceWithState "x = a --> sourceFile r\n"-        `shouldBe` ("x = a --> file r\n", Code)-    it "finishes every tracked Generated module in Code" $ do-      testTree <- treeSnapshot "test"-      let generatedSources = [(path, source) | (path, source) <- testTree, "/Generated/" `isInfixOf` ("/" <> path)]-      generatedSources `shouldSatisfy` (not . null)-      forM_ generatedSources $ \(path, source) -> do-        let (_, finalState) = modernizeGeneratedHaskellSourceWithState source-        unless (finalState == Code) (expectationFailure (path <> " ended in " <> show finalState))--  describe "sidecar migration (EP-198)" $ do-    it "refuses old context names, applies lossless moves, preserves stale history, and is idempotent" $-      withTempDirectory "keiro-dsl-sidecar-migration" $ \base -> do-        parsed <- parsedSourceOf "test/fixtures/reservation.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            sourceLanguage = (.sourceLanguage) parsed-            plain = base </> "plain"-            migrated = base </> "migrated"-            runAt out apply specPath selected =-              executeServiceScaffoldWithRuntimePackageAndNameMigrations-                Nothing-                apply-                out-                False-                specPath-                sourceLanguage-                ctx-                service-                selected-        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)-        _ <- runAt plain False "reservation.keiro" modules >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        _ <- runAt migrated False "reservation.keiro" modules >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        let reduced = drop 1 modules-            currentLedger = contextLedgerFileName (spec.context)-            currentFragment = contextCabalFragmentFileName (spec.context)-            oldLedger = legacyContextRecordFileName (spec.context)-            oldFragment = legacyContextManifestFileName (spec.context)-        renameFile (migrated </> currentLedger) (migrated </> oldLedger)-        renameFile (migrated </> currentFragment) (migrated </> oldFragment)-        treeBefore <- treeSnapshot migrated-        refused <- runAt migrated False "reservation-reduced.keiro" reduced-        refused `shouldSatisfy` \case-          Left [SidecarMigrationRequired moves] ->-            length moves == 2-              && all ((== RenameSidecar) . (.moveDisposition)) moves-          _ -> False-        renderRefusals (either id (const []) refused)-          `shouldSatisfy` any (T.isInfixOf "--apply-name-migrations")-        treeSnapshot migrated `shouldReturn` treeBefore--        baseline <- runAt plain False "reservation-reduced.keiro" reduced >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        applied <- runAt migrated True "reservation-reduced.keiro" reduced >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        map (.moveDisposition) ((.sidecarMoves) applied) `shouldBe` [RenameSidecar, RenameSidecar]-        (.stale) applied `shouldBe` (.stale) baseline-        (.previousSpecPath) applied `shouldBe` Just "reservation.keiro"-        doesFileExist (migrated </> oldLedger) `shouldReturn` False-        doesFileExist (migrated </> oldFragment) `shouldReturn` False-        doesFileExist (migrated </> currentLedger) `shouldReturn` True-        doesFileExist (migrated </> currentFragment) `shouldReturn` True--        rerun <- runAt migrated True "reservation-reduced.keiro" reduced >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        (.sidecarMoves) rerun `shouldBe` []--        let duplicateBytes = "legacy duplicate cabal fragment\n"-            backup = migrated </> ".keiro-dsl-name-migrations/sidecar-v1" </> oldFragment-        TIO.writeFile (migrated </> oldFragment) duplicateBytes-        duplicateRefusal <- runAt migrated False "reservation-reduced.keiro" reduced-        duplicateRefusal `shouldSatisfy` \case-          Left [SidecarMigrationRequired [move]] -> (.moveDisposition) move == RetireLegacySidecar-          _ -> False-        retired <- runAt migrated True "reservation-reduced.keiro" reduced >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        map (.moveDisposition) ((.sidecarMoves) retired) `shouldBe` [RetireLegacySidecar]-        doesFileExist (migrated </> oldFragment) `shouldReturn` False-        TIO.readFile backup `shouldReturn` duplicateBytes--  describe "Haskell.name-diff" $ do-    it "classifies a workqueue payload type rename only on consumer-build" $ do-      base <- specOf "test/fixtures/reservation-work.keiro"-      let renamed = mapWorkqueue (workqueueWithPayloadName "ReservationJob") base-          findings = generatedHaskellNameFindings (diffSpecs base renamed)-      case findings of-        [finding] -> assertGeneratedHaskellNameFinding finding-        values -> expectationFailure ("expected one payload-name finding, got " <> show (length values))-      let workspaceFindings =-            generatedHaskellNameFindings-              (map (.change) (diffWorkspaces (oneMemberWorkspace "queue.keiro" base) (oneMemberWorkspace "queue.keiro" renamed)))-      workspaceFindings `shouldSatisfy` \case [finding] -> isAdvisory finding; _ -> False-      replayImpactSpecs base renamed `shouldBe` ReplayNeutral-    it "pairs a mapped selector rename by unchanged wire key and keeps fold identity stable" $ do-      source <- readTestText "test/fixtures/consumer-types.keiro"-      base <- parseInlineSpec "<mapped-selector-old>" source-      renamed <--        parseInlineSpec-          "<mapped-selector-new>"-          (T.replace "key         as \"key\"" "artifactKey as \"key\"" source)-      let findings = generatedHaskellNameFindings (diffSpecs base renamed)-      case findings of-        [finding] -> do-          assertGeneratedHaskellNameFinding finding-          (.subject) (kindOfChange finding) `shouldSatisfy` T.isInfixOf "artifactKey"-        values -> expectationFailure ("expected one selector-name finding, got " <> show (length values))-      replayImpactSpecs base renamed `shouldBe` ReplayNeutral-      legacyAggregateFoldFingerprint base (onlyAggregate base)-        `shouldBe` legacyAggregateFoldFingerprint renamed (onlyAggregate renamed)-    it "pairs a workqueue module rename by unchanged explicit runtime facts" $ do-      base <- specOf "test/fixtures/reservation-work.keiro"-      let queueOnly = specWithNodes [node | node@NWorkqueue {} <- base.nodes] base-          renamed = mapWorkqueue (workqueueWithName "reservation_jobs") queueOnly-          findings = generatedHaskellNameFindings (diffSpecs queueOnly renamed)-      case findings of-        [finding] -> do-          assertGeneratedHaskellNameFinding finding-          (.facet) (kindOfChange finding) `shouldBe` "workqueue-module"-        values -> expectationFailure ("expected one module-name finding, got " <> show (length values))-      map ((.code) . kindOfChange) (diffSpecs queueOnly renamed) `shouldNotContain` [QueueIdentityChanged]-      replayImpactSpecs queueOnly renamed `shouldBe` ReplayNeutral-    it "emits no finding when edited logical spellings normalize identically" $ do-      base <- specOf "test/fixtures/reservation-work.keiro"-      let queueOnly = specWithNodes [node | node@NWorkqueue {} <- base.nodes] base-          recased = mapWorkqueue (workqueueWithName "reservationWork") queueOnly-      generatedHaskellNameFindings (diffSpecs queueOnly recased) `shouldBe` []--  describe "canonical reservation.keiro" $-    it "parses into the expected aggregate shape" $ do-      input <- readTestText "test/fixtures/reservation.keiro"-      case parseSpec "test/fixtures/reservation.keiro" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> do-          spec.context `shouldBe` "hospital-capacity"-          length ((.ids) spec) `shouldBe` 3-          length ((.enums) spec) `shouldBe` 3-          length ((.rules) spec) `shouldBe` 1-          case (.nodes) spec of-            [NAggregate a] -> do-              (.name) a `shouldBe` "Reservation"-              length ((.states) a) `shouldBe` 6-              length ((.commands) a) `shouldBe` 2-              length ((.events) a) `shouldBe` 2-              length ((.transitions) a) `shouldBe` 2-              map (.terminal) ((.states) a) `shouldBe` [False, False, False, True, True, True]-            other -> expectationFailure ("expected one aggregate node, got " <> show (length other))--  describe "validator" $ do-    it "accepts the canonical reservation.keiro" $ do-      codes <- errorCodesOf "test/fixtures/reservation.keiro"-      codes `shouldBe` []-    it "keeps unrelated aggregate-only specs free of inert-surface warnings" $ do-      codes <- diagnosticCodesOf "test/fixtures/reservation.keiro"-      codes-        `shouldNotContain` [ IntakeBindFlagUnenforced,-                             RmInlineSubscriptionIgnored-                           ]-    it "reports empty aggregates at their declaration under legacy and stable contracts" $ do-      spec <- specOf "test/fixtures/reservation.keiro"-      case [aggregate | NAggregate aggregate <- (.nodes) spec] of-        aggregate : _ -> do-          let emptyAggregate = aggregateWithCommandsEventsTransitions [] [] [] aggregate-              emptySpec = specWithNodes [NAggregate emptyAggregate] spec-              expectedLine = unLoc ((.loc) aggregate)-              planningCodes = [GeneratedPathCollision, GeneratedImportCycle, BehaviorDerivationInvalid, ConformanceFactKeyCollision, GeneratedPlanningInvariantViolation]-              expectedMessage =-                "aggregate 'Reservation' declares no commands, no events, and no transitions; scaffold cannot lower an empty aggregate -- declare at least one command, one event, and one transition"-          forM_ [legacyCheckedService emptySpec, stableCheckedService emptySpec] $ \service -> do-            let diagnostics = checkTestServiceDiagnostics Nothing (defaultContext (emptySpec.context)) service-            [ ((.severity) diagnostic, (.line) diagnostic, (.message) diagnostic)-              | diagnostic <- diagnostics,-                (.code) diagnostic == AggregateEmpty-              ]-              `shouldBe` [(Error, expectedLine, expectedMessage)]-            filter (`elem` planningCodes) (map (.code) diagnostics) `shouldBe` []-          scaffoldRefusals emptySpec `shouldSatisfy` any (T.isPrefixOf "AggregateEmpty:")-        [] -> expectationFailure "reservation fixture has no aggregate"-    it "reports empty contracts at their declaration under legacy and stable contracts" $ do-      spec <- specOf "test/fixtures/contract-v4.keiro"-      case [contract | NContract contract <- (.nodes) spec] of-        contract : _ -> do-          let emptyContract = contractNodeWithEvents [] contract-              emptySpec = specWithNodes [NContract emptyContract] spec-              expectedLine = unLoc ((.loc) contract)-              planningCodes = [GeneratedPathCollision, GeneratedImportCycle, BehaviorDerivationInvalid, ConformanceFactKeyCollision, GeneratedPlanningInvariantViolation]-              expectedMessage =-                "contract 'emergency' declares no events; scaffold cannot lower an empty contract -- declare at least one event"-          forM_ [legacyCheckedService emptySpec, stableCheckedService emptySpec] $ \service -> do-            let diagnostics = checkTestServiceDiagnostics Nothing (defaultContext (emptySpec.context)) service-            [ ((.severity) diagnostic, (.line) diagnostic, (.message) diagnostic)-              | diagnostic <- diagnostics,-                (.code) diagnostic == ContractEmpty-              ]-              `shouldBe` [(Error, expectedLine, expectedMessage)]-            filter (`elem` planningCodes) (map (.code) diagnostics) `shouldBe` []-          scaffoldRefusals emptySpec `shouldSatisfy` any (T.isPrefixOf "ContractEmpty:")-        [] -> expectationFailure "contract fixture has no contract"-    it "keeps a check-time error counterpart for every sampled lowering refusal class" $ do-      emitSource <- readTestText "test/fixtures/emit.keiro"-      incompleteBackoff <- parseInlineSpec "<incomplete-backoff-parity>" (T.replace "backoff constant 2s" "backoff exponential 2s" emitSource)-      baseAggregate <- parseInlineSpec "<lowering-parity>" loweringAggregateSpec-      bareTextInitial <- parseInlineSpec "<bare-text-initial-parity>" (T.replace "\"hello world\"" "hello" loweringAggregateSpec)-      unsupportedField <- parseInlineSpec "<unsupported-field-parity>" (T.replace "count:Int" "count:Json" loweringAggregateSpec)-      mappedInitial <- specOf "test/fixtures/mapped-missing-initial.keiro"-      let candidates =-            [ ("incomplete publisher backoff", incompleteBackoff),-              ("invalid register initial", bareTextInitial),-              ("unrepresentable aggregate field", unsupportedField),-              ("missing mapped register initial", mappedInitial)-            ]-      scaffoldRefusals baseAggregate `shouldBe` []-      forM_ candidates $ \(caseLabel, candidate) ->-        unless-          (not (null (scaffoldRefusals candidate)) && any ((== Error) . (.severity)) (validateSpec candidate))-          (expectationFailure (caseLabel <> " did not fail at both check and scaffold planning"))-    it "rejects policy words that generated Haskell cannot lower" $ do-      emitSpec <- specOf "test/fixtures/emit.keiro"-      intakeSpec <- specOf "test/fixtures/intake.keiro"-      let unknownOrdering = mapPublisher (publisherWithOrdering "banana") emitSpec-          unknownBackoff =-            mapPublisher-              (\publisher -> publisherWithBackoff (backoffWithKind "banana" publisher.backoff) publisher)-              emitSpec-          incompleteBackoff =-            mapPublisher-              (publisherWithBackoff (BackoffSpec "exponential" "2s" Nothing Nothing))-              emitSpec-          unknownDedupe = mapIntake (intakeWithDedupePolicy "Banana") intakeSpec-      errorCodes unknownOrdering `shouldContain` [PublisherOrderingUnknown]-      errorCodes unknownBackoff `shouldContain` [PublisherBackoffInvalid]-      errorCodes incompleteBackoff `shouldContain` [PublisherBackoffInvalid]-      errorCodes unknownDedupe `shouldContain` [IntakeDedupePolicyUnknown]-    it "gates numeric floors on the published stable language-4 contract" $ do-      emitSpec <- specOf "test/fixtures/emit.keiro"-      intakeSpec <- specOf "test/fixtures/intake.keiro"-      readModelSpec <- specOf "test/fixtures/workflow.keiro"-      let zeroContract = mapContract (contractWithSchemaVersion 0) emitSpec-          zeroAttempts = mapPublisher (publisherWithMaxAttempts 0) emitSpec-          zeroDecode = mapIntake (\intake -> intakeWithDecode (decodeWithBodySchemaVersion 0 intake.decode) intake) intakeSpec-          zeroReadModel = modifyReadModel "transferDecision" (readModelWithVersion 0) readModelSpec-          floors =-            [ (zeroContract, ContractSchemaVersionBelowMinimum),-              (zeroAttempts, PublisherMaxAttemptsBelowMinimum),-              (zeroDecode, IntakeDecodeSchemaVersionBelowMinimum),-              (zeroReadModel, ReadModelVersionBelowMinimum)-            ]-      forM_ floors $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldNotContain` [expected]-        serviceErrorCodes 4 candidate `shouldContain` [expected]-    it "rejects duplicate declarations whose generated behavior cannot work" $ do-      reservation <- specOf "test/fixtures/reservation.keiro"-      integration <- specOf "test/fixtures/emit.keiro"-      let duplicateCommandField =-            modifyAggregate-              "Reservation"-              (\aggregate -> aggregateWithCommands (updateFirst (\command -> commandWithFields (duplicateFirst command.fields) command) aggregate.commands) aggregate)-              reservation-          duplicateState = modifyAggregate "Reservation" (\aggregate -> aggregateWithStates (duplicateFirst aggregate.states) aggregate) reservation-          duplicateTransition =-            modifyAggregate-              "Reservation"-              (\aggregate -> aggregateWithTransitions (aggregate.transitions <> take 1 (reverse aggregate.transitions)) aggregate)-              reservation-          duplicateContractField =-            mapContract-              (\contract -> contractNodeWithEvents (updateFirst (\event -> contractEventWithFields (duplicateFirst event.fields) event) contract.events) contract)-              integration-          duplicateContractEvent = mapContract (\contract -> contractNodeWithEvents (duplicateFirst contract.events) contract) integration-          duplicateTopicAlias = mapContract (\contract -> contractWithTopics (duplicateFirst contract.topics) contract) integration-          cases =-            [ (duplicateCommandField, AggregateDuplicateFieldName),-              (duplicateState, AggregateDuplicateState),-              (duplicateTransition, TransitionDuplicateUnguarded),-              (duplicateContractField, ContractDuplicateFieldName),-              (duplicateContractEvent, ContractDuplicateEvent),-              (duplicateTopicAlias, ContractDuplicateTopicAlias)-            ]-      forM_ cases $ \(candidate, expected) -> errorCodes candidate `shouldContain` [expected]-    it "gates ambiguous and silently shadowed duplicate surfaces on language 4" $ do-      reservation <- specOf "test/fixtures/reservation.keiro"-      integration <- specOf "test/fixtures/emit.keiro"-      let duplicateRegister = modifyAggregate "Reservation" (\aggregate -> aggregateWithRegs (duplicateFirst aggregate.regs) aggregate) reservation-          duplicateNominal = specWithIds (duplicateFirst reservation.ids) reservation-          duplicateMap = mapEmit (\emitNode -> emitNodeWithMap (duplicateFirst emitNode.map) emitNode) integration-          shadowDiscriminator =-            mapContract-              ( \contract ->-                  contractNodeWithEvents-                    ( updateFirst-                        (\event -> contractEventWithFields (updateFirst (contractFieldWithName contract.discriminator) event.fields) event)-                        contract.events-                    )-                    contract-              )-              integration-          guardedSibling =-            modifyAggregate-              "Reservation"-              ( \aggregate ->-                  aggregateWithTransitions-                    (aggregate.transitions <> [transitionWithGuard (Just (EAtom (ABool True))) transition | transition <- take 1 (reverse aggregate.transitions)])-                    aggregate-              )-              reservation-          cases =-            [ (duplicateRegister, AggregateDuplicateRegister),-              (duplicateNominal, NominalDuplicateDeclaration),-              (duplicateMap, EmitMapDuplicateCase),-              (shadowDiscriminator, ContractFieldShadowsDiscriminator),-              (guardedSibling, TransitionUnguardedSibling)-            ]-      forM_ cases $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldNotContain` [expected]-        serviceErrorCodes 4 candidate `shouldContain` [expected]-    it "gates stable identities and external names on language 4" $ do-      workflowSpec <- specOf "test/fixtures/workflow.keiro"-      processSpec <- specOf "test/fixtures/surge-service.keiro"-      routerSpec <- specOf "test/fixtures/transfer-routing.keiro"-      integration <- specOf "test/fixtures/emit.keiro"-      let invalidIdentity = mapWorkflow (workflowWithStable "") workflowSpec-          duplicateIdentity =-            specWithNodes-              ( processSpec.nodes-                  <> [NRouter (routerWithName "surge-demo" router) | NRouter router <- routerSpec.nodes]-              )-              processSpec-          invalidTopic = mapContract (\contract -> contractWithTopics [(alias, "bad topic") | (alias, _) <- contract.topics] contract) integration-          emptyTopic = mapContract (\contract -> contractWithTopics [(alias, "") | (alias, _) <- contract.topics] contract) integration-          invalidReadModel = modifyReadModel "transferDecision" (readModelWithTable "Bad-Table") workflowSpec-          duplicateColumn = modifyReadModel "transferDecision" (\readModel -> readModelWithColumns (duplicateFirst readModel.columns) readModel) workflowSpec-          gatedCases =-            [ (invalidIdentity, RuntimeIdentityInvalid),-              (duplicateIdentity, RuntimeIdentityDuplicate),-              (invalidTopic, ContractTopicNameInvalid),-              (invalidReadModel, ReadModelIdentifierInvalid),-              (duplicateColumn, ReadModelDuplicateColumn)-            ]-      forM_ gatedCases $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldNotContain` [expected]-        serviceErrorCodes 4 candidate `shouldContain` [expected]-      serviceErrorCodes 3 emptyTopic `shouldContain` [ContractTopicNameInvalid]-      serviceErrorCodes 4 emptyTopic `shouldContain` [ContractTopicNameInvalid]-    it "gates declared integration and wire couplings on language 4" $ do-      intakeSpec <- specOf "test/fixtures/intake.keiro"-      reservation <- specOf "test/fixtures/reservation.keiro"-      let unresolvedBind =-            mapIntake-              (\intake -> intakeWithBinds (updateFirst (bindRowWithField "ghost") intake.binds) intake)-              intakeSpec-          acceptedEventBind =-            mapIntake-              (\intake -> intakeWithBinds (updateFirst (bindRowWithField "region") intake.binds) intake)-              intakeSpec-          unresolvedDedupe = mapIntake (intakeWithDedupeKey "ghost") intakeSpec-          unknownEnvelope = mapIntake (\intake -> intakeWithDecode (decodeWithEnvelope "banana policy" intake.decode) intake) intakeSpec-          mismatchedSchema = mapIntake (\intake -> intakeWithDecode (decodeWithBodySchemaVersion 2 intake.decode) intake) intakeSpec-          unresolvedAlias =-            mapContract-              (\contract -> contractNodeWithEvents (updateFirst (contractEventWithTopic "ghost") contract.events) contract)-              intakeSpec-          unsupportedWire =-            modifyAggregate-              "Reservation"-              (\aggregate -> aggregateWithWire (fmap (wireSpecWithKind "banana") aggregate.wire) aggregate)-              reservation-          cases =-            [ (unresolvedBind, IntakeBindUnresolved),-              (unresolvedDedupe, IntakeDedupeKeyUnresolved),-              (unknownEnvelope, IntakeEnvelopePolicyUnknown),-              (mismatchedSchema, IntakeDecodeSchemaVersionMismatch),-              (unresolvedAlias, ContractTopicAliasUnresolved),-              (unsupportedWire, WireClauseUnsupported)-            ]-      forM_ cases $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldNotContain` [expected]-        serviceErrorCodes 4 candidate `shouldContain` [expected]-      serviceErrorCodes 4 acceptedEventBind `shouldNotContain` [IntakeBindUnresolved]-    it "gates closed workqueue vocabularies and bounded windows on language 4" $ do-      queueSpec <- specOf "test/fixtures/reservation-work.keiro"-      intakeSpec <- specOf "test/fixtures/intake.keiro"-      emitSpec <- specOf "test/fixtures/emit.keiro"-      processSpec <- specOf "test/fixtures/hospital-surge.keiro"-      let huge = "18446744073709551618s"-          unknownPayload =-            mapWorkqueue-              (\queue -> workqueueWithPayload [if field.name == "hospitalId" then wqFieldWithValueType (LegacyQueueScalar (QueueOther "numeric")) field else field | field <- queue.payload] queue)-              queueSpec-          queueDelay = mapWorkqueue (workqueueWithDelay huge) queueSpec-          queueRetry = mapWorkqueue (\queue -> workqueueWithDisposition (updateFirst (wqDispRowWithAction (IRetry huge)) queue.disposition) queue) queueSpec-          intakeRetry = mapIntake (\intake -> intakeWithDisposition (updateFirst (dispositionRowWithAction (IRetry huge)) intake.disposition) intake) intakeSpec-          publisherBackoff = mapPublisher (\publisher -> publisherWithBackoff (backoffWithWindow huge publisher.backoff) publisher) emitSpec-          publisherMaximum =-            mapPublisher-              (\publisher -> publisherWithBackoff (BackoffSpec "exponential" publisher.backoff.window (Just huge) (Just "2")) publisher)-              emitSpec-          processFireAt =-            modifyProcess-              "HospitalSurge"-              (\process -> processWithTimer (timerWithFireAt (fireAtWithWindow huge process.timer.fireAt) process.timer) process)-              processSpec-          cases =-            [ (unknownPayload, WqPayloadTypeUnknown),-              (queueDelay, WindowOutOfRange),-              (queueRetry, WindowOutOfRange),-              (intakeRetry, WindowOutOfRange),-              (publisherBackoff, WindowOutOfRange),-              (publisherMaximum, WindowOutOfRange),-              (processFireAt, WindowOutOfRange)-            ]-      forM_ cases $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldBe` []-        serviceErrorCodes 4 candidate `shouldContain` [expected]-    -- ExecPlan 199: spellings the grammar accepted that no runtime implements.-    -- Each pair asserts both halves of the contract — the divergent spelling-    -- warns at 3 and errors at 4, and the spelling that matches the runtime-    -- stays completely silent, so these are refusals and not blanket noise.-    it "refuses spec surfaces that contradict the runtime, and stays silent on the ones that describe it" $ do-      intakeSpec <- specOf "test/fixtures/intake.keiro"-      processSpec <- specOf "test/fixtures/hospital-surge.keiro"-      routerSpec <- specOf "test/fixtures/transfer-routing.keiro"-      let lenientBody =-            mapIntake (\intake -> intakeWithDecode (decodeWithBodyStrict False intake.decode) intake) intakeSpec-          unknownHeader =-            mapIntake-              (\intake -> intakeWithBinds (updateFirst (bindRowWithSource (SrcHeader "x-custom")) intake.binds) intake)-              intakeSpec-          retryOnAppended =-            modifyProcess-              "HospitalSurge"-              ( \process ->-                  processWithHandle-                    ( handleWithDispatch-                        ( updateFirst-                            (\d -> dispatchNodeWithDisposition (dispatchDispositionWithOnAppended DRetry d.disposition) d)-                            process.handle.dispatch-                        )-                        process.handle-                    )-                    process-              )-              processSpec-          firedNotMine =-            modifyProcess-              "HospitalSurge"-              ( \process ->-                  let timer = process.timer-                      fire = timer.fire-                   in processWithTimer-                        ( timerWithFire-                            (fireNodeWithDisposition (fireDispositionWithNotMine OFired fire.disposition) fire)-                            timer-                        )-                        process-              )-              processSpec-          routerRetryOnAppended =-            mapRouter-              ( \router ->-                  routerWithDispatch-                    (routerDispatchWithDisposition (dispatchDispositionWithOnAppended DRetry router.dispatch.disposition) router.dispatch)-                    router-              )-              routerSpec-          cases =-            [ (lenientBody, DecodeBodyPostureUnsupported),-              (unknownHeader, IntakeBindHeaderUnknown),-              (retryOnAppended, DispatchOnAppendedUnsupported),-              (firedNotMine, TimerNotMineUnsupported),-              (routerRetryOnAppended, DispatchOnAppendedUnsupported)-            ]-      forM_ cases $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldNotContain` [expected]-        serviceWarningCodes 3 candidate `shouldContain` [expected]-        serviceErrorCodes 4 candidate `shouldContain` [expected]--      -- The unmutated fixtures spell every one of these the way the runtime-      -- behaves, so language 4 has nothing to say about them.-      let closedCodes =-            [ DecodeBodyPostureUnsupported,-              IntakeBindHeaderUnknown,-              DispatchOnAppendedUnsupported,-              TimerNotMineUnsupported-            ]-      forM_ [intakeSpec, processSpec, routerSpec] $ \accepted -> do-        serviceErrorCodes 4 accepted `shouldNotContain` closedCodes-        serviceWarningCodes 4 accepted `shouldNotContain` closedCodes--    -- ExecPlan 197 parked these three as "explicitly descriptive-only"; ExecPlan-    -- 199 re-adjudicated each against the path it purports to describe and found-    -- a checkable referent in every one.-    it "checks the references the formerly descriptive-only surfaces name" $ do-      processSpec <- specOf "test/fixtures/hospital-surge.keiro"-      dispatchSpec <- specOf "test/fixtures/reservation-work.keiro"-      let unknownStatus =-            modifyProcess-              "HospitalSurge"-              (\process -> processWithTimer (timerWithDecodeUnknown "Abandoned" process.timer) process)-              processSpec-          blankDeadLetter =-            modifyProcess-              "HospitalSurge"-              (\process -> processWithTimer (timerWithDeadLetter "   " process.timer) process)-              processSpec-          phantomDedupeKey =-            mapPgmqDispatch (pgmqDispatchWithDedupKey "ghostKey") dispatchSpec-          uppercaseFanout =-            mapPgmqDispatch (pgmqDispatchWithFanoutBody "ResolveTransferCandidates") dispatchSpec-          cases =-            [ (unknownStatus, TimerDecodeStatusUnknown),-              (blankDeadLetter, TimerDeadLetterTextInvalid),-              (phantomDedupeKey, DispatchReadModelFieldUnknown),-              (uppercaseFanout, PgmqFanoutFunctionInvalid)-            ]-      forM_ cases $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldNotContain` [expected]-        serviceWarningCodes 3 candidate `shouldContain` [expected]-        serviceErrorCodes 4 candidate `shouldContain` [expected]--      -- Every timer status the runtime actually stores is accepted.-      forM_ ["Scheduled", "Firing", "Fired", "Cancelled", "Dead"] $ \status ->-        serviceErrorCodes-          4-          (modifyProcess "HospitalSurge" (\p -> processWithTimer (timerWithDecodeUnknown status p.timer) p) processSpec)-          `shouldNotContain` [TimerDecodeStatusUnknown]--      serviceErrorCodes 4 processSpec `shouldNotContain` [TimerDecodeStatusUnknown, TimerDeadLetterTextInvalid]-      serviceErrorCodes 4 dispatchSpec `shouldNotContain` [PgmqFanoutFunctionInvalid]--    it "holds a process dispatch-id line to the same strictness as a router's" $ do-      -- Both lines document a derivation the spec cannot change, but the two-      -- runtimes key on different tuples: Keiro.ProcessManager on-      -- (name, correlationId, sourceEventId, emitIndex) and Keiro.Router on-      -- (name, key, sourceEventId, targetStreamName, occurrence). Before-      -- ExecPlan 199 the process line accepted any strategy and any tuple.-      processSource <- readTestText "test/fixtures/hospital-surge.keiro"-      let processLine = "dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)"-          rejected =-            [ "dispatch-id strategy=md5 from=(name, correlationId, sourceEventId, emitIndex)",-              "dispatch-id strategy=uuidv5 from=(banana)",-              "dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId)",-              -- The router's tuple is not the process's tuple.-              "dispatch-id strategy=uuidv5 from=(name, key, sourceEventId, targetStreamName, occurrence)"-            ]-      processSource `shouldSatisfy` T.isInfixOf processLine-      parseSpec "accepted" processSource `shouldSatisfy` isRight-      forM_ rejected $ \badLine ->-        parseSpec "mutated" (T.replace processLine badLine processSource)-          `shouldSatisfy` isLeft--    it "gates the remaining locally resolvable identity and field surfaces on language 4" $ do-      reservation <- specOf "test/fixtures/reservation.keiro"-      emitSpec <- specOf "test/fixtures/emit.keiro"-      processSpec <- specOf "test/fixtures/hospital-surge.keiro"-      dispatchSpec <- specOf "test/fixtures/reservation-work.keiro"-      readModelSpec <- specOf "test/fixtures/readmodel.keiro"-      let projectionKey = modifyAggregate "Reservation" (\aggregate -> aggregateWithProjection (fmap (projectionSpecWithKey "ghost") aggregate.projection) aggregate) reservation-          outboxField = mapPublisher (publisherWithOutboxField "ghost") emitSpec-          timerIds =-            modifyProcess-              "HospitalSurge"-              ( \process ->-                  let timer = process.timer-                      fire = timer.fire-                   in processWithTimer-                        ( timerWithIdAndFire-                            (idExprWithField "ghostTimerKey" timer.id)-                            (fireNodeWithFiredEventId (idExprWithField "ghostEventKey" fire.firedEventId) fire)-                            timer-                        )-                        process-              )-              processSpec-          sourceKey = mapDispatch (pgmqDispatchWithSourceKey "ghost") dispatchSpec-          subscriptionIdentity = modifyReadModel "transfer_decisions" (\readModel -> readModelWithSupply (setLegacySubscription (Just "bad subscription") readModel.supply) readModel) readModelSpec-          scopeIdentity = modifyReadModel "transfer_decisions" (\readModel -> readModelWithSupply (setLegacyScope (Just (RmCategory "bad-category")) readModel.supply) readModel) readModelSpec-          cases =-            [ (projectionKey, AggProjectionKeyUnresolved),-              (outboxField, PublisherOutboxFieldUnresolved),-              (timerIds, TimerIdFieldNotCorrelation),-              (sourceKey, DispatchReadModelFieldUnknown),-              (subscriptionIdentity, RuntimeIdentityInvalid),-              (scopeIdentity, RuntimeIdentityInvalid)-            ]-      forM_ cases $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldBe` []-        serviceErrorCodes 4 candidate `shouldContain` [expected]-      length (filter (== TimerIdFieldNotCorrelation) (serviceErrorCodes 4 timerIds)) `shouldBe` 2-      parseStableRenderedSpec "<timer-id-fields>" timerIds `shouldBe` Right timerIds-    it "uses a router-specific code for a confirmed duplicate inversion" $ do-      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      let changed =-            modifyRouter-              "PagingRouter"-              ( \router ->-                  let dispatch = router.dispatch-                      disposition = dispatch.disposition-                   in routerWithDispatch-                        (routerDispatchWithDisposition (dispatchDispositionWithOnDuplicate DAckOk disposition) dispatch)-                        router-              )-              spec-          warningCodes = [(.code) diagnostic | diagnostic <- validateSpec changed, (.severity) diagnostic == Warning]-      warningCodes `shouldContain` [RouterBenignInversion]-      warningCodes `shouldNotContain` [ProcessBenignInversion]-    it "pins every emitted legacy single-spec diagnostic that lacked a direct negative test" $ do-      reservation <- specOf "test/fixtures/reservation.keiro"-      intakeSpec <- specOf "test/fixtures/intake.keiro"-      emitSpec <- specOf "test/fixtures/emit.keiro"-      processSpec <- specOf "test/fixtures/surge-service.keiro"-      queueSpec <- specOf "test/fixtures/reservation-work.keiro"-      workflowSpec <- specOf "test/fixtures/workflow.keiro"-      let updateFirstTransition update aggregate = aggregateWithTransitions (updateFirst update aggregate.transitions) aggregate-          undeclaredEvent = modifyAggregate "Reservation" (updateFirstTransition (transitionWithEmits ["GhostEvent"])) reservation-          undeclaredState = modifyAggregate "Reservation" (updateFirstTransition (transitionWithGoto "GhostState")) reservation-          terminalOutgoing = modifyAggregate "Reservation" (updateFirstTransition (transitionWithSource "Expired")) reservation-          deprecatedEmitted = modifyAggregate "Reservation" (\aggregate -> aggregateWithEvents (updateFirst (eventWithDeprecated True) aggregate.events) aggregate) reservation-          wireVersionMismatch = modifyAggregate "Reservation" (\aggregate -> aggregateWithWire (fmap (wireSpecWithSchemaVersion 2) aggregate.wire) aggregate) reservation-          decodeRetry =-            mapIntake-              ( \intake ->-                  intakeWithDisposition-                    [ if row.outcome == "decodeFailed" then dispositionRowWithAction (IRetry "5s") row else row-                    | row <- intake.disposition-                    ]-                    intake-              )-              intakeSpec-          unresolvedPublisher = mapPublisher (publisherWithEmit "ghost") emitSpec-          unresolvedIntake = mapIntake (intakeWithContract "ghost") intakeSpec-          unboundedQueue = mapWorkqueue (workqueueWithMaxRetries 0) queueSpec-          unresolvedEnqueue = mapDispatch (pgmqDispatchWithEnqueueTo "ghost") queueSpec-          unresolvedWorkflow =-            mapOperation-              ( \operation -> case (.shape) operation of-                  RunOp _ input outcome -> operationWithShape (RunOp "GhostWorkflow" input outcome) operation-                  _ -> operation-              )-              workflowSpec-          cases =-            [ (undeclaredEvent, UndeclaredEvent),-              (undeclaredState, UndeclaredState),-              (terminalOutgoing, TerminalHasOutgoing),-              (deprecatedEmitted, DeprecatedEventStillEmitted),-              (wireVersionMismatch, WireSchemaVersionMismatch),-              (processSpec, ProcessBenignInversion),-              (decodeRetry, DispositionDecodeUnboundedRetry),-              (unresolvedPublisher, PublisherUnresolvedEmit),-              (unresolvedIntake, IntakeUnresolvedContract),-              (unboundedQueue, WqDlqWithoutCeiling),-              (unresolvedEnqueue, DispatchEnqueueUnresolved),-              (unresolvedWorkflow, RunWorkflowUnresolved)-            ]-      forM_ cases $ \(candidate, expected) -> diagnosticCodes candidate `shouldContain` [expected]-    it "rejects a missing status-map as StatusMapNotTotal" $ do-      codes <- diagnosticCodesOf "test/fixtures/reservation-no-statusmap.keiro"-      codes `shouldContain` [StatusMapNotTotal]-    it "rejects an undeclared command as UndeclaredCommand" $ do-      codes <- diagnosticCodesOf "test/fixtures/reservation-bad-command.keiro"-      codes `shouldContain` [UndeclaredCommand]-    it "rejects a wall-clock guard atom as ClockSampled" $ do-      codes <- diagnosticCodesOf "test/fixtures/reservation-clock.keiro"-      codes `shouldContain` [ClockSampled]-    it "accepts a v2 event with a contiguous upcaster hole" $ do-      codes <- errorCodesOf "test/fixtures/reservation-v2.keiro"-      codes `shouldBe` []-    it "rejects a v2 event with no upcaster as EvtVersionMissingUpcaster" $ do-      codes <- diagnosticCodesOf "test/fixtures/reservation-v2-noupcast.keiro"-      codes `shouldContain` [EvtVersionMissingUpcaster]-    it "accepts shared upcaster sources for different event kinds" $ do-      codes <- errorCodesOf "test/fixtures/reservation-dup-upcast-source.keiro"-      codes `shouldBe` []-    it "rejects a gap in the aggregate-global upcaster chain" $ do-      codes <- errorCodesOf "test/fixtures/reservation-chain-gap.keiro"-      codes `shouldContain` [UpcasterChainGap]-    it "warns while a retiring event keeps its live emitting transition" $ do-      diagnostics <- diagnosticsOf "test/fixtures/reservation-retiring.keiro"-      [(.code) d | d <- diagnostics, (.severity) d == Error] `shouldBe` []-      [(.code) d | d <- diagnostics, (.severity) d == Warning]-        `shouldContain` [EventRetirementInProgress]-    it "rejects a retiring event after its live emitting transition disappears" $ do-      source <- readTestText "test/fixtures/reservation-retiring.keiro"-      spec <- parseInlineSpec "<retiring-without-emitter>" (T.replace "emit TransferReservationConfirmed ; " "" source)-      [(.code) d | d <- validateSpec spec, (.severity) d == Error]-        `shouldContain` [EventRetirementInProgress]-    it "warns when a deprecated event has no replay-only emitting transition" $ do-      diagnostics <- diagnosticsOf "test/fixtures/reservation-deprecated.keiro"-      [(.code) d | d <- diagnostics, (.severity) d == Error] `shouldBe` []-      [(.code) d | d <- diagnostics, (.severity) d == Warning]-        `shouldContain` [DeprecatedEventReplayHazard]-    it "recognises deprecated plus replay-only as the replay-safe cutover" $ do-      diagnostics <- diagnosticsOf "test/fixtures/reservation-deprecated-replay-only.keiro"-      [(.code) d | d <- diagnostics, (.severity) d == Error] `shouldBe` []-      [(.code) d | d <- diagnostics, (.severity) d == Warning]-        `shouldContain` [EventRetirementInProgress]-      [(.code) d | d <- diagnostics] `shouldNotContain` [DeprecatedEventReplayHazard]-    it "requires exact, unique status-map event keys" $ do-      dangling <- errorCodesOf "test/fixtures/statusmap-dangling.keiro"-      mapM_ (\expected -> dangling `shouldContain` [expected]) [StatusMapDanglingKey, StatusMapNotTotal]-      duplicate <- errorCodesOf "test/fixtures/statusmap-dup-key.keiro"-      duplicate `shouldContain` [StatusMapDuplicateKey]-    it "rejects duplicate aggregate source subjects before semantic duplicate-name validation" $ do-      source <- readTestText "test/fixtures/duplicate-names.keiro"-      surface <- case parseSurfaceSource "test/fixtures/duplicate-names.keiro" source of-        Left frontendFailure -> expectationFailure (show frontendFailure) >> fail "unreachable"-        Right value -> pure value-      case lowerSurfaceDocument surface of-        Left LoweringFailure {code = SemanticSourceIndexInvalid DuplicateSourceSubject} -> pure ()-        other -> expectationFailure ("expected duplicate source-subject lowering refusal, got " <> show other)--      let withoutDuplicateAggregate = T.unlines (reverse (drop 3 (reverse (T.lines source))))-      parsed <- case parseSource "test/fixtures/duplicate-names.keiro" withoutDuplicateAggregate of-        Left parseFailure -> expectationFailure (show parseFailure) >> fail "unreachable"-        Right value -> pure value-      let spec = parsed.spec-          codes = [(.code) diagnostic | diagnostic <- validateSpec spec, (.severity) diagnostic == Error]-      mapM_-        (\expected -> codes `shouldContain` [expected])-        [ DuplicateEnumCtor,-          DuplicateEnumWire,-          DuplicateIdPrefix,-          DuplicateCommandName,-          DuplicateEventName-        ]-      case [node | node@NAggregate {} <- (.nodes) spec] of-        aggregateNode : _ ->-          [(.code) diagnostic | diagnostic <- validateSpec (specWithNodes (spec.nodes <> [aggregateNode]) spec), (.severity) diagnostic == Error]-            `shouldContain` [DuplicateNodeName]-        [] -> expectationFailure "duplicate-name fixture lost its aggregate"-    it "rejects aggregate-local references that do not resolve" $ do-      codes <- errorCodesOf "test/fixtures/aggregate-bad-refs.keiro"-      mapM_ (\expected -> codes `shouldContain` [expected]) [RegisterInitialOutOfScope, UndeclaredCommand, WriteTargetNotRegister]-    it "anchors UnreachableState on the state row" $ do-      let src =-            T.unlines-              [ "context repro",-                "",-                "aggregate Thing",-                "  regs",-                "  states",-                "    Initial",-                "    Unreachable"-              ]-      case parseSpec "<unreachable-row>" src of-        Left err -> expectationFailure (T.unpack err)-        Right spec ->-          [(.line) d | d <- validateSpec spec, (.code) d == UnreachableState]-            `shouldBe` [7]-    it "accepts a replay-only twin with a live sibling (plan 143)" $ do-      codes <- errorCodesOf "test/fixtures/reservation-guard-tightened-twin.keiro"-      codes `shouldBe` []-    it "rejects a replay-only transition that emits nothing" $ do-      case parseSpec "<replay-only-no-emit>" (replayOnlySpecWith ["    write reservationState := Held", "    goto  Held"]) of-        Left err -> expectationFailure (T.unpack err)-        Right spec ->-          [(.code) d | d <- validateSpec spec, (.severity) d == Error]-            `shouldContain` [ReplayOnlyEmitsNothing]-    it "warns when a replay-only transition has no live sibling" $ do-      case parseSpec "<replay-only-orphan>" (replayOnlySpecWith ["    emit  TransferReservationCreated", "    goto  Held"]) of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> do-          [(.code) d | d <- validateSpec spec, (.severity) d == Warning]-            `shouldContain` [ReplayOnlyCommandStillLive]-          [(.code) d | d <- validateSpec spec, (.severity) d == Error]-            `shouldNotContain` [ReplayOnlyCommandStillLive]--  describe "complementExpr (plan 143)" $ do-    it "applies De Morgan over and/or and flips comparison operators" $ do-      let a = EAtom (AName "a")-          b = EAtom (AName "b")-      complementExpr (EAnd a b)-        `shouldBe` EOr (ECmp OpEq a (EAtom (ABool False))) (ECmp OpEq b (EAtom (ABool False)))-      complementExpr (ECmp OpLt a b) `shouldBe` ECmp OpGe a b-      complementExpr (ECmp OpEq a b) `shouldBe` ECmp OpNeq a b-      complementExpr (ECmp OpLe a b) `shouldBe` ECmp OpGt a b-      complementExpr (ECmp OpGt a b) `shouldBe` ECmp OpLe a b-      complementExpr (ECmp OpGe a b) `shouldBe` ECmp OpLt a b-      complementExpr (ECmp OpNeq a b) `shouldBe` ECmp OpEq a b-    it "flips boolean literals and grounds bare names as == false" $ do-      complementExpr (EAtom (ABool True)) `shouldBe` EAtom (ABool False)-      complementExpr (EAtom (AName "open"))-        `shouldBe` ECmp OpEq (EAtom (AName "open")) (EAtom (ABool False))-    it "stays inside the grammar: the complement of any guard re-parses" $-      property $-        forAll genExpr $ \e ->-          let twin =-                replayOnlySpecWith-                  [ "    guard " <> renderExprText (complementExpr e),-                    "    emit  TransferReservationCreated",-                    "    goto  Held"-                  ]-           in case parseSpec "<complement>" twin of-                Left err -> counterexample (T.unpack err) False-                Right spec ->-                  [(.guard) t | NAggregate a <- (.nodes) spec, t <- (.transitions) a]-                    === [Just (complementExpr e)]--  describe "evolution parsing" $ do-    it "parses event version and upcaster from reservation-v2.keiro" $ do-      input <- readTestText "test/fixtures/reservation-v2.keiro"-      case parseSpec "test/fixtures/reservation-v2.keiro" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> case [e | NAggregate a <- (.nodes) spec, e <- (.events) a, (.name) e == "TransferReservationCreated"] of-          (e : _) -> do-            (.version) e `shouldBe` 2-            (.upcastFrom) e `shouldBe` Just (1, Hole)-          [] -> expectationFailure "TransferReservationCreated not found"-    it "round-trips the retiring marker" $ do-      spec <- specOf "test/fixtures/reservation-retiring.keiro"-      parseStableRenderedSpec "<retiring-round-trip>" spec `shouldBe` Right spec-      [(.retiring) event | NAggregate aggregate <- (.nodes) spec, event <- (.events) aggregate, (.name) event == "TransferReservationConfirmed"]-        `shouldBe` [True]-    it "rejects an event marked both retiring and deprecated" $ do-      source <- readTestText "test/fixtures/reservation-retiring.keiro"-      let conflicting = T.replace "retiring event TransferReservationConfirmed" "retiring deprecated event TransferReservationConfirmed" source-      parseSpec "<conflicting-retirement-markers>" conflicting `shouldSatisfy` isLeft--  describe "aggregate snapshots (EP-109)" $ do-    it "parses, validates, and round-trips a snapshot policy with codec fixture" $ do-      spec <- specOf "test/fixtures/reservation-snapshot.keiro"-      errorCodesOf "test/fixtures/reservation-snapshot.keiro" `shouldReturn` []-      parseStableRenderedSpec "<snapshot-round-trip>" spec `shouldBe` Right spec-      case [aggregate | NAggregate aggregate <- (.nodes) spec] of-        [aggregate] -> (.snapshot) aggregate `shouldBe` Just (SnapshotSpec (SnapEvery 100) 1 "7a181ceb7d798d883d28c85201c5c1692bd314a7b489da9128bff91e0f38cd28" noLoc)-        aggregates -> expectationFailure ("expected one snapshot aggregate, got " <> show (length aggregates))-    it "rejects disabled intervals and invalid codec fixtures" $ do-      source <- readTestText "test/fixtures/reservation-snapshot.keiro"-      interval <- parseInlineSpec "<snapshot-zero>" (T.replace "snapshot every 100" "snapshot every 0" source)-      map (.code) (validateSpec interval) `shouldContain` [SnapshotIntervalInvalid]-      version <- parseInlineSpec "<snapshot-version-zero>" (T.replace "state-codec version=1" "state-codec version=0" source)-      map (.code) (validateSpec version) `shouldContain` [SnapshotCodecFixtureInvalid]-      emptyHash <- parseInlineSpec "<snapshot-empty-hash>" (T.replace "shape-hash=\"7a181ceb7d798d883d28c85201c5c1692bd314a7b489da9128bff91e0f38cd28\"" "shape-hash=\"\"" source)-      map (.code) (validateSpec emptyHash) `shouldContain` [SnapshotCodecFixtureInvalid]-    it "conditionally lowers JSON instances and the live defaultStateCodec" $ do-      snapshotService <- checkedServiceOf "test/fixtures/reservation-snapshot.keiro"-      ordinaryService <- checkedServiceOf "test/fixtures/reservation.keiro"-      let snapshot = checkedSpec snapshotService-          ordinary = checkedSpec ordinaryService-      case ([aggregate | NAggregate aggregate <- (.nodes) snapshot], [aggregate | NAggregate aggregate <- (.nodes) ordinary]) of-        ([_], [_]) -> do-          let snapshotModules = scaffoldServiceModules (defaultContext (snapshot.context)) snapshotService-              ordinaryModules = scaffoldServiceModules (defaultContext (ordinary.context)) ordinaryService-              snapshotDomain = generatedTextEndingIn "Domain.hs" snapshotModules-              snapshotStream = generatedTextEndingIn "EventStream.hs" snapshotModules-              ordinaryDomain = generatedTextEndingIn "Domain.hs" ordinaryModules-              ordinaryStream = generatedTextEndingIn "EventStream.hs" ordinaryModules-          snapshotDomain `shouldSatisfy` T.isInfixOf "deriving anyclass (ToJSON, FromJSON)"-          snapshotStream `shouldSatisfy` T.isInfixOf "snapshotPolicy = Every 100"-          snapshotStream `shouldSatisfy` T.isInfixOf "stateCodec = Just (withFoldFingerprint"-          snapshotStream `shouldSatisfy` T.isInfixOf "Spec-visible fold changes invalidate old"-          snapshotStream `shouldSatisfy` T.isInfixOf "reservationSnapshotFixture = (1, \"7a181ceb7d798d883d28c85201c5c1692bd314a7b489da9128bff91e0f38cd28\")"-          ordinaryDomain `shouldNotSatisfy` T.isInfixOf "DeriveAnyClass"-          ordinaryStream `shouldSatisfy` T.isInfixOf "snapshotPolicy = Never"-          ordinaryStream `shouldSatisfy` T.isInfixOf "stateCodec = Nothing"-          ordinaryStream `shouldSatisfy` T.isInfixOf "reservationCategory = Stream.categoryUnsafe \"reservation\""-          firewallBreaches snapshotModules `shouldBe` []-        _ -> expectationFailure "expected one aggregate in each snapshot test spec"--  describe "aggregate fold fingerprints (plan 138)" $ do-    it "is deterministic across repeated parses and formatting-only changes" $ do-      source <- readTestText "test/fixtures/reservation.keiro"-      first <- parseInlineSpec "<first>" source-      second <- shouldParseStableRenderedSpec "<second>" first-      aggregateFoldFingerprint first (onlyAggregate first)-        `shouldBe` aggregateFoldFingerprint second (onlyAggregate second)-    it "changes for transition writes, guards, and referenced rule bodies" $ do-      base <- specOf "test/fixtures/reservation.keiro"-      writeChanged <- specOf "test/fixtures/reservation-foldchange.keiro"-      guardChanged <- specOf "test/fixtures/reservation-guard-tightened.keiro"-      source <- readTestText "test/fixtures/reservation.keiro"-      ruleChanged <- parseInlineSpec "<rule-change>" (T.replace "RedTag => true" "RedTag => false" source)-      let baseFingerprint = aggregateFoldFingerprint base (onlyAggregate base)-      aggregateFoldFingerprint writeChanged (onlyAggregate writeChanged) `shouldNotBe` baseFingerprint-      aggregateFoldFingerprint guardChanged (onlyAggregate guardChanged) `shouldNotBe` baseFingerprint-      aggregateFoldFingerprint ruleChanged (onlyAggregate ruleChanged) `shouldNotBe` baseFingerprint-    it "ignores wire and projection changes" $ do-      base <- specOf "test/fixtures/reservation.keiro"-      wireChanged <- specOf "test/fixtures/reservation-wire.keiro"-      source <- readTestText "test/fixtures/reservation.keiro"-      projectionChanged <- parseInlineSpec "<projection-change>" (T.replace "projection transfer_decisions" "projection renamed_projection" source)-      let surface = aggregateFoldSurface base (onlyAggregate base)-      aggregateFoldSurface wireChanged (onlyAggregate wireChanged) `shouldBe` surface-      aggregateFoldSurface projectionChanged (onlyAggregate projectionChanged) `shouldBe` surface-    it "invalidates mapped-register snapshots when binding or wire identity changes" $ do-      base <- specOf "test/fixtures/consumer-types.keiro"-      bindingChanged <- specOf "test/fixtures/consumer-types-binding-change.keiro"-      wireChanged <- specOf "test/fixtures/consumer-types-wirekey.keiro"-      let baseFingerprint = aggregateFoldFingerprint base (onlyAggregate base)-      aggregateFoldFingerprint bindingChanged (onlyAggregate bindingChanged) `shouldNotBe` baseFingerprint-      aggregateFoldFingerprint wireChanged (onlyAggregate wireChanged) `shouldNotBe` baseFingerprint--  describe "process/timer (EP-3)" $ do-    it "parses the hospital-surge process + nested timer" $ do-      input <- readTestText "test/fixtures/hospital-surge.keiro"-      case parseSpec "test/fixtures/hospital-surge.keiro" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> case [p | NProcess p <- (.nodes) spec] of-          (p : _) -> do-            p.id `shouldBe` "HospitalSurge"-            (.name) p `shouldBe` "hospital-surge"-            (.rejected) p `shouldBe` PolHalt-            (.poison) p `shouldBe` PolHalt-            (.category) ((.saga) p) `shouldBe` "hospitalSurge"-            (.name) ((.timer) p) `shouldBe` "surgeFollowUp"-            (.onReject) ((.disposition) ((.fire) ((.timer) p))) `shouldBe` OFired-            (.onAmbiguous) ((.disposition) ((.fire) ((.timer) p))) `shouldBe` ORetry-            (.maxAttempts) ((.timer) p) `shouldBe` 5-          [] -> expectationFailure "no process node parsed"-    it "round-trips the hospital-surge spec through parse . pretty" $ do-      input <- readTestText "test/fixtures/hospital-surge.keiro"-      case parseSpec "in" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> parseLanguage4RenderedSpec "in" spec `shouldBe` Right spec-    it "accepts the hospital-surge spec (no errors; benign-inversion warnings only)" $ do-      codes <- errorCodesOf "test/fixtures/hospital-surge.keiro"-      codes `shouldBe` []-    it "rejects illegal saga categories and no longer parses the raw stream-prefix clause" $ do-      spec <- specOf "test/fixtures/hospital-surge.keiro"-      mapM_-        (\categoryName -> processErrorCodes (\process -> processWithSaga (sagaRefWithCategory categoryName process.saga) process) spec `shouldContain` [SagaCategoryIllegal])-        ["", "$all", "hospital-surge", "hospital surge", "wf:surge"]-      source <- readTestText "test/fixtures/hospital-surge.keiro"-      parseSpec "<legacy-saga>" (T.replace "saga Surge category \"hospitalSurge\"" "saga Surge stream=\"hospital-surge-\" <> correlationId" source)-        `shouldSatisfy` isLeft-    it "rejects a wall-clock fireAt as ProcessFireAtNotInjected" $ do-      codes <- errorCodesOf "test/fixtures/hospital-surge-clock.keiro"-      codes `shouldContain` [ProcessFireAtNotInjected]-    it "reports one ProcessFireAtNotInjected for a wholly unknown fireAt field" $ do-      codes <- errorCodesOf "test/fixtures/hospital-surge-clock.keiro"-      length (filter (== ProcessFireAtNotInjected) codes) `shouldBe` 1-    it "rejects a user-supplied dispatch id as ProcessDispatchIdSupplied" $ do-      codes <- errorCodesOf "test/fixtures/hospital-surge-dispatchid.keiro"-      codes `shouldContain` [ProcessDispatchIdSupplied]-    it "rejects an unresolved saga reference as ProcessUnresolvedRef" $ do-      codes <- errorCodesOf "test/fixtures/hospital-surge-badref.keiro"-      codes `shouldContain` [ProcessUnresolvedRef]-    it "rejects unresolved process commands, projections, schedules, and advance ids" $ do-      codes <- errorCodesOf "test/fixtures/process-ghost-refs.keiro"-      length (filter (== ProcessUnresolvedRef) codes) `shouldBe` 5-      codes `shouldContain` [ProcessDispatchIdSupplied]-    it "gates process correlate, dispatch-key, and binding scopes on language 4" $ do-      spec <- specOf "test/fixtures/hospital-surge.keiro"-      let badCorrelate =-            modifyProcess-              "HospitalSurge"-              (\process -> processWithCorrelate (correlateDeclWithField "ghost" process.correlate) process)-              spec-          badDispatchKey =-            modifyProcess-              "HospitalSurge"-              ( \process ->-                  let handle = process.handle-                   in processWithHandle (handleWithDispatch (updateFirst (dispatchNodeWithKey "input.ghost") handle.dispatch) handle) process-              )-              spec-          badBinding =-            modifyProcess-              "HospitalSurge"-              ( \process ->-                  let handle = process.handle-                      advance = handle.advance-                   in processWithHandle-                        (handleWithAdvance (advanceNodeWithFields (updateFirst (fieldBindingWithValue (Just "ghost.value")) advance.advFields) advance) handle)-                        process-              )-              spec-          cases =-            [ (badCorrelate, ProcessKeyFieldUnknown),-              (badDispatchKey, ProcessDispatchKeyUnresolved),-              (badBinding, ProcessBindingUnscoped)-            ]-      forM_ cases $ \(candidate, expected) -> do-        serviceErrorCodes 3 candidate `shouldNotContain` [expected]-        serviceErrorCodes 4 candidate `shouldContain` [expected]-      serviceErrorCodes 4 spec-        `shouldNotContain` [ProcessKeyFieldUnknown, ProcessDispatchKeyUnresolved, ProcessBindingUnscoped]--  describe "router (EP-108)" $ do-    it "RouterSelection parses, checks, fingerprints, and round-trips bounded declarative selection" $ do-      source <- readTestText "test/fixtures/declarative-router/valid.keiro"-      parsed <- case parseSource "declarative-router.keiro" source of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      let service = checkedSource parsed-          spec = checkedSpec service-      [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error] `shouldBe` []-      parseSource "declarative-router-roundtrip.keiro" (renderSource parsed) `shouldBe` Right parsed-      graph <- shouldResolveTypeGraph spec-      case [router | NRouter router <- (.nodes) spec] of-        [router] -> case RouterSelection.checkRouterSelection (checkedLanguageContract service) graph spec router of-          Left diagnostics -> expectationFailure (show diagnostics)-          Right selection -> do-            (.identity) selection `shouldBe` "hospital-transfer-selection"-            (.version) selection `shouldBe` 1-            (.limit) selection `shouldBe` 64-            (.useSites) selection `shouldSatisfy` (not . null)-            T.length ((.fingerprint) selection) `shouldBe` 64-            (.fingerprint) selection-              `shouldSatisfy` T.all (`elem` ("0123456789abcdef" :: String))-        routers -> expectationFailure ("expected one declarative router, got " <> show (length routers))--    it "generates the checked declarative selection without a selection-owned RouterHoles module" $ do-      service <- checkedServiceOf "test/fixtures/declarative-router/valid.keiro"-      let spec = checkedSpec service-          modules = scaffoldServiceModules (defaultContext (spec.context)) service-          routerModule = generatedTextEndingIn "HospitalTransferRouter/Router.hs" modules-          routerHarness = generatedTextEndingIn "HospitalTransferRouter/RouterHarness.hs" modules-      [(.path) generatedModule | generatedModule <- modules, "HospitalTransferRouter/Router.hs" `T.isSuffixOf` T.pack ((.path) generatedModule)]-        `shouldBe` ["Generated/TransferRouting/HospitalTransferRouter/Router.hs"]-      [(.path) hole | hole <- modules, "HospitalTransferRouter/RouterHoles.hs" `T.isSuffixOf` T.pack ((.path) hole)]-        `shouldBe` []-      routerModule `shouldSatisfy` T.isInfixOf "DeclarativeRouter"-      routerModule `shouldSatisfy` T.isInfixOf "runQuery Nothing SelectionQuery.hospitalLoadReadModel input"-      routerModule `shouldSatisfy` T.isInfixOf "fieldWitnessGet StructuralProjections.hospitalLoadRowHospitalIdWitness row"-      routerModule `shouldSatisfy` T.isInfixOf "hospitalTransferRouterSelectionContract"-      routerModule `shouldSatisfy` T.isInfixOf "hospitalTransferRouterSelectionFingerprint"-      routerHarness `shouldSatisfy` T.isInfixOf "(\"resolverOwnership\", \"generated-declarative\")"-      routerHarness `shouldSatisfy` T.isInfixOf "(\"maxRecipients\", \"64\")"-      firewallBreaches modules `shouldBe` []--    it "classifies every declarative selection coordination transition" $ do-      source <- readTestText "test/fixtures/declarative-router/valid.keiro"-      baseline <- checkedServiceFromText "selection-baseline.keiro" source-      identityChanged <- checkedServiceFromText "selection-identity.keiro" (T.replace "identity = \"hospital-transfer-selection\"" "identity = \"hospital-transfer-selection-v2\"" source)-      versionTwo <- checkedServiceFromText "selection-version-two.keiro" (T.replace "version = 1" "version = 2" source)-      fingerprintChanged <- checkedServiceFromText "selection-fingerprint.keiro" (T.replace "max-recipients = 64" "max-recipients = 32" source)-      versionedFingerprintChanged <- checkedServiceFromText "selection-versioned-fingerprint.keiro" (T.replace "version = 1" "version = 2" (T.replace "max-recipients = 64" "max-recipients = 32" source))-      let custom =-            checkedServiceWithSpec-              ( modifyRouter-                  "HospitalTransferRouter"-                  ( \router ->-                      router-                        { input = ((.input) router) {valueType = Nothing, fields = [Field "transferNeedId" Nothing, Field "region" Nothing]},-                          resolve = ResolveDecl ResolveHole ["hospitalId"] ((.loc) ((.resolve) router))-                        }-                  )-                  (checkedSpec baseline)-              )-              baseline-          classifyCoordination old new = [(impact.reason, (.severity) impact) | impact <- coordinationImpact old new []]-      case routerSelectionSnapshots baseline of-        [snapshot] -> do-          (.verification) snapshot `shouldBe` DeclarativeVerified-          (.identity) snapshot `shouldBe` Just "hospital-transfer-selection"-          (.version) snapshot `shouldBe` Just 1-          fmap T.length ((.fingerprint) snapshot) `shouldBe` Just 64-          Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot-        snapshots -> expectationFailure ("expected one router selection ledger snapshot, got " <> show snapshots)-      classifyCoordination baseline identityChanged `shouldBe` [(SelectionIdentityChanged, CoordinationBreaking)]-      classifyCoordination versionTwo baseline `shouldBe` [(SelectionVersionDecreased, CoordinationBreaking)]-      classifyCoordination baseline fingerprintChanged `shouldBe` [(SelectionFingerprintChangedWithoutVersionBump, CoordinationBreaking)]-      classifyCoordination baseline versionedFingerprintChanged `shouldBe` [(SelectionFingerprintChangedWithVersionBump, CoordinationAdvisory)]-      classifyCoordination baseline versionTwo `shouldBe` [(SelectionVersionMetadataOnly, CoordinationAdvisory)]-      classifyCoordination baseline custom `shouldBe` [(SelectionVerificationBoundaryChanged, CoordinationAdvisory)]-      let breakingReport = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReportWithImpacts defaultGate [] [] (coordinationImpact baseline fingerprintChanged []))))-      breakingReport `shouldSatisfy` T.isInfixOf "\"breaking\":true"--    it "keeps formatting out of the fingerprint and reports mapped selection dependencies in both sections" $ do-      source <- readTestText "test/fixtures/declarative-router/valid.keiro"-      baseline <- checkedServiceFromText "selection-semantic-baseline.keiro" source-      formatted <- checkedServiceFromText "selection-semantic-formatted.keiro" (T.replace "context transfer-routing\n" "context transfer-routing\n\n" source)-      coordinationImpact baseline formatted [] `shouldBe` []-      let changed = checkedServiceWithSpec (mapMappedStructural "HospitalLoadRow" changeMappedCanonical (checkedSpec baseline)) baseline-          semantic = CheckedDiff.mappedSemanticImpactForServices baseline changed-          coordination = coordinationImpact baseline changed semantic-          rowDelta = find ((== MappedKey "HospitalLoadRow") . (.declaration)) semantic-          rendered = T.unlines (renderCoordinationImpact coordination)-          encoded = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReportWithImpacts defaultGate [] semantic coordination)))-          isSelectionConsumer = \case RouterSelectionConsumer {} -> True; _ -> False-      rowDelta `shouldSatisfy` maybe False (any isSelectionConsumer . Set.toList . (.currentConsumers))-      map (.reason) coordination `shouldContain` [SelectionMappedDependencyChanged]-      rendered `shouldSatisfy` T.isInfixOf "selection-mapped-dependency-changed"-      encoded `shouldSatisfy` T.isInfixOf "\"coordinationImpact\""-      encoded `shouldSatisfy` T.isInfixOf "router-selection:HospitalTransferRouter:recipient"-      LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReport defaultGate [])))-        `shouldNotSatisfy` T.isInfixOf "coordinationImpact"--    it "RouterSelection gates declarative selection at the version-5 marker" $ do-      source <- readTestText "test/fixtures/declarative-router/valid.keiro"-      let version4 = "language keiro-dsl 4\ncontext transfer-routing\n\n" <> snd (T.breakOn "router HospitalTransferRouter" source)-      case parseSurfaceSource "declarative-router-v4.keiro" version4 of-        Left FrontendFailure {code = SourceLanguageError LanguageFeatureRequiresVersion, span = SourceSpan {start = SourcePoint {offset = startOffset}, end = SourcePoint {offset = endOffset}}} ->-          T.take (endOffset - startOffset) (T.drop startOffset version4) `shouldBe` "declarative"-        Left failure -> expectationFailure (show failure)-        Right _ -> expectationFailure "language 4 unexpectedly accepted declarative selection"--    it "RouterSelection rejects unbounded selection at its declaration" $ do-      diagnostics <- diagnosticsOf "test/fixtures/declarative-router/unbounded.keiro"-      [((.line) diagnostic, (.code) diagnostic) | diagnostic <- diagnostics, (.severity) diagnostic == Error]-        `shouldBe` [(79, RouterSelectionRecipientLimitMissing)]--    it "RouterSelection assigns a dedicated diagnostic to every declarative selection rejection class" $ do-      source <- readTestText "test/fixtures/declarative-router/valid.keiro"-      let mutationCases =-            [ ("empty-identity", T.replace "identity = \"hospital-transfer-selection\"" "identity = \"\"", RouterSelectionIdentityEmpty),-              ("zero-version", T.replace "version = 1" "version = 0", RouterSelectionVersionInvalid),-              ("unknown-query", T.replace "read-model hospital_load" "read-model missing_load", RouterSelectionQueryUnknown),-              ("missing-query-contract", T.replace "  query input = TransferRouteInput\n  query result = List HospitalLoadRow\n" "", RouterSelectionQueryContractMissing),-              ("input-mismatch", T.replace "input AcceptedHospitalTransferNeed : TransferRouteInput" "input AcceptedHospitalTransferNeed : HospitalLoadRow", RouterSelectionQueryInputTypeMismatch),-              ("non-list-result", T.replace "query result = List HospitalLoadRow" "query result = HospitalLoadRow", RouterSelectionQueryResultNotList),-              ("unknown-root", T.replace "recipient = row.hospitalId" "recipient = resolved.hospitalId", RouterSelectionExpressionRootUnknown),-              ("unknown-field", T.replace "recipient = row.hospitalId" "recipient = row.missingHospitalId", RouterSelectionExpressionFieldUnknown),-              ("nullable-recipient", T.replace ": Text required\n    region" ": Optional Text required\n    region", RouterSelectionExpressionFieldOptional),-              ("predicate-type", T.replace "where = row.region == input.region && row.availableBeds > 0" "where = row.region", RouterSelectionPredicateNotBool),-              ("recipient-type", T.replace "recipient = row.hospitalId" "recipient = row.availableBeds", RouterSelectionRecipientNotText),-              ("operator", T.replace "recipient = row.hospitalId" "recipient = row.availableBeds + 1", RouterSelectionOperatorUnsupported),-              ("zero-limit", T.replace "max-recipients = 64" "max-recipients = 0", RouterSelectionRecipientLimitInvalid),-              ("order", T.replace "order = target-stream" "order = query-order", RouterSelectionOrderUnsupported),-              ("dedupe", T.replace "dedupe = target-stream" "dedupe = none", RouterSelectionDedupeUnsupported),-              ("failure-ack", T.replace "failure => retry" "failure => ack", RouterSelectionFailureAckForbidden),-              ("redelivery", T.replace "redelivery = stable-union" "redelivery = replace", RouterSelectionRedeliveryUnsupported),-              ("partial", T.replace "partial = retain-successes" "partial = rollback", RouterSelectionPartialDispatchUnsupported),-              ("target", T.replace "target Hospital\n" "target MissingHospital\n", RouterSelectionTargetAmbiguous),-              ("command", T.replace "dispatch-each RouteAcceptedTransferNeed" "dispatch-each MissingCommand", RouterSelectionCommandUnknown),-              ("duplicate-field", T.replace "    hospitalId=row.hospitalId\n" "    hospitalId=row.hospitalId\n    hospitalId=row.hospitalId\n", RouterSelectionCommandMappingDuplicate),-              ("incomplete-field", T.replace "    hospitalId=row.hospitalId\n" "", RouterSelectionCommandMappingIncomplete),-              ("field-type", T.replace "hospitalId:Text" "hospitalId:Int", RouterSelectionCommandMappingTypeMismatch)-            ]-      forM_ mutationCases $ \(caseLabel, mutate, expected) -> do-        service <- checkedServiceFromText ("declarative-router-" <> caseLabel <> ".keiro") (mutate source)-        [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]-          `shouldContain` [expected]--    it "parses the incident-paging router shape" $ do-      input <- readTestText "test/fixtures/incident-paging/incident-paging.keiro"-      case parseSpec "test/fixtures/incident-paging/incident-paging.keiro" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> case [router | NRouter router <- (.nodes) spec] of-          [router] -> do-            router.id `shouldBe` "PagingRouter"-            (.name) router `shouldBe` "jitsurei-paging"-            (.field) ((.key) router) `shouldBe` "incidentId"-            (.source) ((.resolve) router) `shouldBe` ResolveReadModel "service_oncall"-            (.row) ((.resolve) router) `shouldBe` ["responderId"]-            (.command) ((.dispatch) router) `shouldBe` "SendPage"-            (.rejected) router `shouldBe` PolDeadLetter-            (.poison) router `shouldBe` PolHalt-          routers -> expectationFailure ("expected one router, got " <> show (length routers))-    it "round-trips the incident-paging spec through parse . pretty" $ do-      input <- readTestText "test/fixtures/incident-paging/incident-paging.keiro"-      case parseSpec "in" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> parseLanguage4RenderedSpec "in" spec `shouldBe` Right spec-    it "accepts the incident-paging router with warnings only" $ do-      codes <- errorCodesOf "test/fixtures/incident-paging/incident-paging.keiro"-      codes `shouldBe` []-      diagnostics <- diagnosticCodesOf "test/fixtures/incident-paging/incident-paging.keiro"-      diagnostics `shouldContain` [PolicyDeadLetterUnused, AmbiguousFollowsRejectedPolicy]-    it "rejects unresolved targets, keys, commands, and binding scopes" $ do-      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      routerErrorCodes (routerWithTarget "Pge") spec `shouldContain` [RouterUnresolvedRef]-      routerErrorCodes (\router -> routerWithKey (correlateDeclWithField "incidntId" router.key) router) spec `shouldContain` [RouterKeyFieldUnknown]-      routerErrorCodes (\router -> routerWithDispatch (routerDispatchWithCommand "SendPag" router.dispatch) router) spec `shouldContain` [RouterCommandUnknown]-      routerErrorCodes-        ( \router ->-            let dispatch = router.dispatch-             in routerWithDispatch (routerDispatchWithFields [FieldBinding "responderId" (Just "resolved.responder")] dispatch) router-        )-        spec-        `shouldContain` [RouterBindingUnscoped]-    it "rejects unresolved read models and contradictory rejection policies" $ do-      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      let withoutReadModel = removeReadModel "service_oncall" spec-      errorCodes withoutReadModel `shouldContain` [RouterUnresolvedRef]-      routerErrorCodes-        ( \router ->-            let dispatch = router.dispatch-                disposition = dispatch.disposition-             in routerWithRejectedAndDispatch-                  PolHalt-                  (routerDispatchWithDisposition (dispatchDispositionWithOnFailed (DDeadLetter "page rejected") disposition) dispatch)-                  router-        )-        spec-        `shouldContain` [PolicyContradiction]-    it "gates resolve-row column verification on language 4" $ do-      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      let unresolved =-            modifyRouter-              "PagingRouter"-              (\router -> routerWithResolve (resolveDeclWithRow ["ghostColumn"] router.resolve) router)-              spec-      serviceErrorCodes 3 unresolved `shouldNotContain` [RouterReadModelUnverified]-      serviceErrorCodes 4 unresolved `shouldContain` [RouterReadModelUnverified]-      serviceErrorCodes 4 spec `shouldNotContain` [RouterReadModelUnverified]-    it "rejects on-ambiguous Fired for process timers" $ do-      spec <- specOf "test/fixtures/hospital-surge.keiro"-      let changed =-            specWithNodes-              [ case node of-                  NProcess process ->-                    let timer = process.timer-                        fire = timer.fire-                        disposition = fire.disposition-                     in NProcess-                          ( processWithTimer-                              (timerWithFire (fireNodeWithDisposition (fireDispositionWithOnAmbiguous OFired disposition) fire) timer)-                              process-                          )-                  _ -> node-              | node <- spec.nodes-              ]-              spec-      errorCodes changed `shouldContain` [AmbiguousMarkedBenign]-    it "requires explicit policy and ambiguity clauses in the grammar" $ do-      source <- readTestText "test/fixtures/hospital-surge.keiro"-      parseSpec "<missing-poison>" (T.replace "  poison => halt\n" "" source) `shouldSatisfy` isLeft-      parseSpec "<missing-ambiguous>" (T.replace " ; on-ambiguous Retry" "" source) `shouldSatisfy` isLeft-    it "scaffolds firewall-clean router wiring, policies, and typed-hole guidance" $ do-      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      case [router | NRouter router <- (.nodes) spec] of-        [router] -> do-          let ctx = defaultContext (spec.context)-              modules = scaffoldRouter ctx router-              generated = [m | m <- modules, (.kind) m == Generated]-              holes = [m | m <- modules, (.kind) m == HoleStub]-          firewallBreaches generated `shouldBe` []-          case (generated, holes) of-            ([generatedModule], [moduleName]) -> do-              (.text) generatedModule `shouldSatisfy` T.isInfixOf "pagingRouterWorkerOptions"-              (.text) generatedModule `shouldSatisfy` T.isInfixOf "rejectedCommandPolicy = RejectedDeadLetter"-              (.text) moduleName `shouldSatisfy` T.isInfixOf "UNION of resolved target identities"-              (.text) moduleName `shouldSatisfy` T.isInfixOf "confirmBenignDuplicate"-            _ -> expectationFailure "expected one generated router module and one router hole module"-        routers -> expectationFailure ("expected one router, got " <> show (length routers))-    it "requires a caller callback for non-halting poison policies" $ do-      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      case [router | NRouter router <- (.nodes) spec] of-        [router] -> do-          let ctx = defaultContext (spec.context)-              generatedFor choice = [(.text) m | m <- scaffoldRouter ctx (routerWithPoison choice router), (.kind) m == Generated]-          mapM_-            ( \(choice, constructor) -> case generatedFor choice of-                [generatedModule] -> do-                  generatedModule `shouldSatisfy` T.isInfixOf "(Envelope msg -> Eff es ()) -> WorkerOptions es msg"-                  generatedModule `shouldSatisfy` T.isInfixOf (constructor <> " poisonCallback")-                _ -> expectationFailure "expected one generated router module"-            )-            [(PolDeadLetter, "PoisonDeadLetter"), (PolSkip, "PoisonSkip")]-          case [(.text) m | m <- scaffoldRouter ctx (routerWithRejected PolSkip router), (.kind) m == Generated] of-            [generatedModule] -> generatedModule `shouldSatisfy` T.isInfixOf "rejectedCommandPolicy = RejectedSkip"-            _ -> expectationFailure "expected one generated router module"-        routers -> expectationFailure ("expected one router, got " <> show (length routers))-    it "emits router harness facts that pin policy and target-keyed identity" $ do-      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      case [router | NRouter router <- (.nodes) spec] of-        [router] -> case harnessRouter (defaultContext (spec.context)) router of-          [facts] -> do-            (.text) facts `shouldSatisfy` T.isInfixOf "(\"rejectedPolicy\", \"deadLetter\")"-            (.text) facts `shouldSatisfy` T.isInfixOf "targetStreamName, occurrence"-          modules -> expectationFailure ("expected one router harness, got " <> show (length modules))-        routers -> expectationFailure ("expected one router, got " <> show (length routers))-    it "rejects invalid timer ceilings and target field bindings" $ do-      codes <- errorCodesOf "test/fixtures/process-bad-timer.keiro"-      mapM_-        (\expected -> codes `shouldContain` [expected])-        [ProcessTimerCeilingInvalid, ProcessFieldBindingUnresolved]-    it "accepts resolved process projection references" $ do-      codes <- errorCodesOf "test/fixtures/surge-service.keiro"-      codes `shouldBe` []-    it "scaffolds the process: Generated wiring is firewall-clean + a HoleStub" $ do-      mods <- legacyScaffoldProcessFixture "test/fixtures/hospital-surge.keiro"-      let gens = [m | m <- mods, (.kind) m == Generated]-          holes = [m | m <- mods, (.kind) m == HoleStub]-      length holes `shouldBe` 1-      firewallBreaches gens `shouldBe` []-      case gens of-        [generatedModule] -> do-          -- the worker uses the spec's ceiling, never the dangerous default-          (.text) generatedModule `shouldSatisfy` T.isInfixOf "max-attempts = 5"-          (.text) generatedModule `shouldSatisfy` T.isInfixOf "hospitalSurgeProcessWorkerOptions"-          (.text) generatedModule `shouldSatisfy` T.isInfixOf "import Generated.HospitalCapacity.Surge.EventStream (SurgeEventStreamDef)"-          (.text) generatedModule `shouldSatisfy` T.isInfixOf "hospitalSurgeCategory :: Stream.StreamCategory SurgeEventStreamDef"-          (.text) generatedModule `shouldSatisfy` T.isInfixOf "hospitalSurgeCategory = Stream.categoryUnsafe \"hospitalSurge\""-          (.text) generatedModule `shouldSatisfy` T.isInfixOf "confirmBenignDuplicate"-          (.text) generatedModule `shouldSatisfy` T.isInfixOf "StreamName -> EventId -> CommandError -> Eff es Bool"-          (.text) generatedModule `shouldSatisfy` T.isInfixOf "Left (CommandAmbiguous _)"-          case holes of-            [moduleName] -> (.text) moduleName `shouldSatisfy` T.isInfixOf "entityStream hospitalSurgeCategory"-            _ -> expectationFailure "expected one process hole module"-        _ -> expectationFailure "expected one generated process module"-    it "process scaffold is deterministic" $ do-      a <- legacyScaffoldProcessFixture "test/fixtures/hospital-surge.keiro"-      b <- legacyScaffoldProcessFixture "test/fixtures/hospital-surge.keiro"-      map (.text) a `shouldBe` map (.text) b-    it "separates aggregate event-stream and command-target categories and emits stable typed sums" $ do-      spec <- specOf "test/fixtures/hospital-surge.keiro"-      let ctx = defaultContext (spec.context)-          modules = concat [scaffoldAggregate ctx spec aggregate | NAggregate aggregate <- (.nodes) spec]-          surgeStream = generatedTextEndingIn "Surge/EventStream.hs" modules-          surgeDomain = generatedTextEndingIn "Surge/Domain.hs" modules-      surgeStream `shouldSatisfy` T.isInfixOf "surgeCategory :: Stream.StreamCategory SurgeEventStreamDef"-      surgeStream `shouldSatisfy` T.isInfixOf "surgeCommandCategory :: Stream.StreamCategory SurgeCommand"-      surgeDomain `shouldNotSatisfy` T.isInfixOf "{-# LANGUAGE EmptyDataDecls #-}"-      surgeDomain `shouldSatisfy` T.isInfixOf "data SurgeEvent = SurgeThresholdNoted"-      surgeDomain `shouldSatisfy` (not . T.isInfixOf "data SurgeEvent = ()")--  describe "contract (EP-4)" $ do-    it "parses the emergency contract (topics + events-on-topic + typed fields)" $ do-      input <- readTestText "test/fixtures/contract.keiro"-      case parseSpec "test/fixtures/contract.keiro" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> case [c | NContract c <- (.nodes) spec] of-          (c : _) -> do-            (.name) c `shouldBe` "emergency"-            (.discriminator) c `shouldBe` "messageType"-            map fst ((.topics) c) `shouldBe` ["incidentEvents", "hospitalEvents"]-            map (.name) ((.events) c) `shouldBe` ["IncidentTransferNeedDeclared", "TransferReservationAccepted"]-          [] -> expectationFailure "no contract node parsed"--    it "branches contract scaffolding, manifests, and durable identities only for language 4" $ do-      sourceText <- readTestText "test/fixtures/contract-v4.keiro"-      parsed <- case parseSource "contract-v4.keiro" sourceText of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      let service = checkedSource parsed-          spec = checkedSpec service-          ctx = defaultContext (spec.context)-      contract <- case [value | NContract value <- (.nodes) spec] of-        [value] -> pure value-        values -> expectationFailure ("expected one contract, got " <> show (length values)) >> fail "unreachable"-      legacyModule <- case scaffoldContract ctx contract of-        [value] -> pure value-        values -> expectationFailure ("expected one legacy module, got " <> show (length values)) >> fail "unreachable"-      typedModule <- case scaffoldContractForService ctx service contract of-        [value] -> pure value-        values -> expectationFailure ("expected one typed module, got " <> show (length values)) >> fail "unreachable"-      let dependencies = manifestDependenciesForService service-          identities = idDomainIdentitiesForService service-          manifestText = renderManifestForService "contract-v4.keiro" [typedModule] service-      assertGeneratedHaskellContract "contract-v4.keiro" manifestText-      committed <- readTestText "test/conformance-contract/Generated/HospitalCapacity/Emergency/Contract.hs"-      normalizeGenerated ((.text) typedModule) `shouldBe` normalizeGenerated committed-      (.text) legacyModule `shouldSatisfy` T.isInfixOf "incidentId :: !Text"-      (.text) legacyModule `shouldSatisfy` (not . T.isInfixOf "KindID")-      (.text) typedModule `shouldSatisfy` T.isInfixOf "incidentId :: !(KindID \"inc\")"-      (.text) typedModule `shouldSatisfy` T.isInfixOf "KindID.toText payload.incidentId"-      (.text) typedModule `shouldSatisfy` T.isInfixOf "explicitParseField (parseKindIdV7Value @\"inc\") o \"incidentId\""-      (.text) typedModule `shouldSatisfy` T.isInfixOf "  , incidentEventsTopic"-      (.text) typedModule `shouldSatisfy` T.isInfixOf "  , hospitalEventsTopic"-      (.text) typedModule `shouldSatisfy` (not . T.isInfixOf "Wno-unused-top-binds")-      dependencies `shouldBe` ["aeson", "base", "keiro-core", "mmzk-typeid", "text"]-      manifestDependencies spec `shouldBe` ["aeson", "base", "text"]-      forM_ dependencies $ \dependency -> manifestText `shouldSatisfy` T.isInfixOf ("    , " <> dependency)-      identities-        `shouldBe` [ "id-domain|name=contract:emergency.IncidentTransferNeedDeclared.incidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text",-                     "id-domain|name=contract:emergency.TransferReservationAccepted.incidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text",-                     "id-domain|name=contract:emergency.TransferReservationAccepted.reservationId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=rsv|separator=_|json=canonical-json-text",-                     "id-domain|name=contract:emergency.TransferReservationAccepted.hospitalId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=hsp|separator=_|json=canonical-json-text"-                   ]--    it "persists contract ID domains in single-file and workspace records with owner attribution" $ do-      sourceText <- readTestText "test/fixtures/contract-v4.keiro"-      parsed <- case parseSource "contract-v4.keiro" sourceText of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right value -> pure value-      let service = checkedSource parsed-          spec = checkedSpec service-          ctx = defaultContext (spec.context)-          modules = scaffoldServiceModules ctx service-          identities = idDomainIdentitiesForService service-      duplicateIdentity <- case identities of-        value : _ -> pure value-        [] -> expectationFailure "typed contract service did not expose ID-domain identities" >> fail "unreachable"-      withTempDirectory "keiro-dsl-v4-contract-record" $ \out -> do-        result <- executeServiceScaffold out False "contract-v4.keiro" ((.sourceLanguage) parsed) ctx service modules-        result `shouldSatisfy` isRight-        contents <- TIO.readFile (out </> recordFileName (spec.context))-        record <- maybe (expectationFailure "typed contract scaffold record did not parse" >> fail "unreachable") pure (parseRecord contents)-        (.idDomains) record `shouldBe` identities-        parseRecord (contents <> "id-domain " <> duplicateIdentity <> "\n") `shouldBe` Nothing--      let manifest = "service hospital-capacity\nspec domain/contract.keiro\n"-          source = memoryContentSource (Map.fromList [("service.keiro-workspace", manifest), ("domain/contract.keiro", sourceText)])-      loaded <- loadWorkspace source "service.keiro-workspace"-      workspace <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure loaded-      workspacePlan <- either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure (planWorkspaceScaffold "goldens" ctx workspace)-      case [provenance | (scaffoldModule, provenance) <- workspacePlan.modules, (.path) scaffoldModule == "Generated/HospitalCapacity/Emergency/Contract.hs"] of-        [MemberOwned owner] -> owner `shouldBe` "domain/contract.keiro"-        values -> expectationFailure ("expected one member-owned contract module, got " <> show values)-      withTempDirectory "keiro-dsl-v4-contract-workspace-record" $ \out -> do-        result <- executeWorkspaceScaffold out False workspacePlan-        result `shouldSatisfy` isRight-        contents <- TIO.readFile (out </> workspaceRecordFileName (workspace.service))-        record <- maybe (expectationFailure "typed contract workspace record did not parse" >> fail "unreachable") pure (parseWorkspaceRecord contents)-        (.idDomains) record `shouldBe` identities-        [((.path) row, (.owner) row) | row <- record.modules, (.path) row == "Generated/HospitalCapacity/Emergency/Contract.hs"]-          `shouldBe` [("Generated/HospitalCapacity/Emergency/Contract.hs", Just "domain/contract.keiro")]-        parseWorkspaceRecord (contents <> "id-domain " <> duplicateIdentity <> "\n") `shouldBe` Nothing-    it "round-trips the contract spec through parse . pretty" $ do-      input <- readTestText "test/fixtures/contract.keiro"-      case parseSource "in" input of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-        Right source -> parseSource "in" (renderSource source) `shouldBe` Right source-    it "round-trips the intake (inbox) spec through parse . pretty" $ do-      input <- readTestText "test/fixtures/intake.keiro"-      case parseSpec "in" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> parseSpec "in" (renderSpec spec) `shouldBe` Right spec-    it "accepts the intake spec (complete disposition, no inversions)" $ do-      codes <- errorCodesOf "test/fixtures/intake.keiro"-      codes `shouldBe` []-    it "warns when intake bind flags describe unenforced generated behavior" $ do-      codes <- diagnosticCodesOf "test/fixtures/intake.keiro"-      codes `shouldContain` [IntakeBindFlagUnenforced]-    it "lowers explicit dedupe-only persistence and defaults omission to full-envelope" $ do-      spec <- specOf "test/fixtures/intake.keiro"-      ordinary <- specOf "test/fixtures/intake-decode.keiro"-      case ([intake | NIntake intake <- (.nodes) spec], [intake | NIntake intake <- (.nodes) ordinary]) of-        ([intake], [defaultIntake]) -> do-          (.persist) intake `shouldBe` InkPersistDedupeOnly-          (.persist) defaultIntake `shouldBe` InkPersistFull-          renderSpec spec `shouldSatisfy` T.isInfixOf "persist = dedupe-only"-          renderSpec ordinary `shouldNotSatisfy` T.isInfixOf "persist ="-          let inbox = generatedTextEndingIn "Inbox.hs" (scaffoldIntake (defaultContext (spec.context)) intake)-          inbox `shouldSatisfy` T.isInfixOf "inboxPersistence = PersistDedupeOnly"-          inbox `shouldSatisfy` T.isInfixOf "data IncidentInboxOutcome"-          inbox `shouldSatisfy` T.isInfixOf "data IncidentInboxDisposition"-          inbox `shouldSatisfy` T.isInfixOf "InboxRetryAfter !RetryDelay !(Maybe InboxFailure)"-          inbox `shouldSatisfy` T.isInfixOf "InboxDeadLetter !(Maybe Text) !(Maybe InboxFailure)"-          inbox `shouldSatisfy` T.isInfixOf "InboxHandlerFailed reason attempts ->"-          inbox `shouldNotSatisfy` T.isInfixOf "Nothing -> InboxRetry"-        (intakes, defaultIntakes) ->-          expectationFailure ("expected one intake in each fixture, got " <> show (length intakes, length defaultIntakes))-    it "rejects duplicate => retry (inversion 1)" $ do-      codes <- errorCodesOf "test/fixtures/intake-dup-retry.keiro"-      codes `shouldContain` [DispositionDuplicateRetry]-    it "rejects previouslyFailed => retry (inversion 2)" $ do-      codes <- errorCodesOf "test/fixtures/intake-pf-retry.keiro"-      codes `shouldContain` [DispositionPreviouslyFailedRetry]-    it "rejects an incomplete disposition table" $ do-      codes <- errorCodesOf "test/fixtures/intake-incomplete.keiro"-      codes `shouldContain` [DispositionIncomplete]-    it "rejects a shadowing duplicate intake disposition row" $ do-      codes <- errorCodesOf "test/fixtures/intake-dup-row.keiro"-      codes `shouldContain` [DispositionDuplicateOutcome]-    it "rejects intake events declared on another topic" $ do-      codes <- errorCodesOf "test/fixtures/intake-topic-mismatch.keiro"-      codes `shouldContain` [TopicAffinityMismatch]-    it "round-trips the emit/publisher spec through parse . pretty" $ do-      input <- readTestText "test/fixtures/emit.keiro"-      case parseSpec "in" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> parseSpec "in" (renderSpec spec) `shouldBe` Right spec-    it "accepts the emit/publisher spec (skip present, coupling resolves)" $ do-      codes <- errorCodesOf "test/fixtures/emit.keiro"-      codes `shouldBe` []-    -- `derive … hole` is mandatory emit grammar, so a diagnostic saying it-    -- generates nothing would fire on every emit node in every spec and could-    -- never be resolved. It is the scaffold report's inert-node line (asserted-    -- immediately below) that carries the fact, once per run. See ExecPlan 199.-    it "leaves an emit-bearing spec clean enough for --deny-warnings" $ do-      (exitCode, out, err) <- runKeiroDsl ["check", "test/fixtures/emit.keiro", "--deny-warnings"]-      unless (exitCode == ExitSuccess) (expectationFailure (out <> err))-      err `shouldNotContain` "escalated to failure"-    it "reports emit nodes that contribute no generated modules" $-      withTempDirectory "keiro-dsl-inert-report" $ \out -> do-        spec <- specOf "test/fixtures/emit.keiro"-        report <- executePlannedScaffold out "test/fixtures/emit.keiro" (defaultContext (spec.context)) spec-        (.inertNodes) report `shouldBe` [("emit", "reservationResponse")]-        renderScaffoldReport report-          `shouldSatisfy` any-            ( T.isInfixOf-                "no-modules: emit reservationResponse (validated and diff-classified; no generated modules)"-            )-    it "rejects a missing _ => skip catch-all as EmitSkipMissing" $ do-      codes <- errorCodesOf "test/fixtures/emit-noskip.keiro"-      codes `shouldContain` [EmitSkipMissing]-    it "rejects mapping to an undeclared contract event as EmitUnresolvedContract" $ do-      codes <- errorCodesOf "test/fixtures/emit-badevent.keiro"-      codes `shouldContain` [EmitUnresolvedContract]-    it "rejects emit events declared on another topic" $ do-      codes <- errorCodesOf "test/fixtures/emit-topic-mismatch.keiro"-      codes `shouldContain` [TopicAffinityMismatch]--  describe "pgmq workqueue/dispatch (EP-5)" $ do-    it "round-trips the reservation-work spec through parse . pretty" $ do-      input <- readTestText "test/fixtures/reservation-work.keiro"-      case parseSpec "in" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> parseSpec "in" (renderSpec spec) `shouldBe` Right spec-    it "accepts the reservation-work spec (physical matches, no inversions)" $ do-      codes <- errorCodesOf "test/fixtures/reservation-work.keiro"-      codes `shouldBe` []-    it "rejects a divergent captured physical name as WqPhysicalDivergence" $ do-      codes <- errorCodesOf "test/fixtures/reservation-work-divergent.keiro"-      codes `shouldContain` [WqPhysicalDivergence]-    it "rejects storeFailure => deadLetter as WqStoreFailureNotRetry" $ do-      codes <- errorCodesOf "test/fixtures/reservation-work-sf-deadletter.keiro"-      codes `shouldContain` [WqStoreFailureNotRetry]-    it "rejects decodeFailure => retry as WqDecodeFailureNotDeadLetter" $ do-      codes <- errorCodesOf "test/fixtures/reservation-work-df-retry.keiro"-      codes `shouldContain` [WqDecodeFailureNotDeadLetter]-    it "requires complete, unique workqueue disposition rows" $ do-      incomplete <- errorCodesOf "test/fixtures/workqueue-incomplete.keiro"-      incomplete `shouldContain` [WqDispositionIncomplete]-      duplicateSpec <- specOf "test/fixtures/workqueue-dup-row.keiro"-      let duplicateDiagnostics = [d | d <- validateSpec duplicateSpec, (.code) d == DispositionDuplicateOutcome]-      map (.line) duplicateDiagnostics `shouldBe` [18]-    it "checks the captured queueRef dlq and table fixtures" $ do-      dlqCodes <- errorCodesOf "test/fixtures/workqueue-dlq-divergent.keiro"-      dlqCodes `shouldContain` [WqDlqDivergence]-      tableCodes <- errorCodesOf "test/fixtures/workqueue-table-divergent.keiro"-      tableCodes `shouldContain` [WqTableDivergence]-    it "matches queueRef for upper-case, punctuation, and hashed logical names" $ do-      upper <- errorCodesOf "test/fixtures/workqueue-uppercase-logical.keiro"-      upper `shouldBe` []-      hashed <- errorCodesOf "test/fixtures/workqueue-hashed-logical.keiro"-      hashed `shouldBe` []-      derivedQueueTrio "hospital_capacity.reservation_work.per_hospital_fifo_lane_assignments"-        `shouldBe` ( "hospital_capacity_reservat_757040df00976c33",-                     "hospital_capacity_reservat_757040df00976c33_dlq",-                     "pgmq.q_hospital_capacity_reservat_757040df00976c33"-                   )-    it "resolves dispatch dedup queues and payload wire fields" $ do-      ghost <- errorCodesOf "test/fixtures/dispatch-dedup-ghost-queue.keiro"-      ghost `shouldContain` [DispatchDedupQueueUnresolved]-      field <- errorCodesOf "test/fixtures/dispatch-dedup-bad-field.keiro"-      field `shouldContain` [DispatchDedupFieldUnresolved]-    it "requires a resolvable group key exactly when ordering is FIFO" $ do-      noKey <- errorCodesOf "test/fixtures/reservation-work-fifo-nokey.keiro"-      noKey `shouldContain` [WqGroupKeyMissing]-      unordered <- errorCodesOf "test/fixtures/reservation-work-key-unordered.keiro"-      unordered `shouldContain` [WqGroupKeyWithoutFifo]-      source <- readTestText "test/fixtures/reservation-work.keiro"-      unresolved <- parseInlineSpec "<unresolved-group-key>" (T.replace "group key from reservationId" "group key from missingId" source)-      map (.code) (validateSpec unresolved) `shouldContain` [WqGroupKeyUnresolved]-    it "warns on unlogged storage and rejects empty partition settings" $ do-      warningCodes <- diagnosticCodesOf "test/fixtures/reservation-work-unlogged.keiro"-      warningCodes `shouldContain` [WqUnloggedDurability]-      partitionCodes <- errorCodesOf "test/fixtures/reservation-work-partitioned-empty.keiro"-      partitionCodes `shouldContain` [WqPartitionSpecEmpty]-    -- Every payload field is required — generated decoders use `o .:` for all of-    -- them — so the marker no longer selects anything. A source that omits it and-    -- a source that writes it describe the same queue and produce identical-    -- output. See ExecPlan 199.-    it "treats a payload field as required whether or not the marker is written" $ do-      unmarkedSource <- readTestText "test/fixtures/reservation-work-optfield.keiro"-      let bare = "    note -> \"note\" text"-          markedSource = T.replace bare (bare <> " required") unmarkedSource-      unmarkedSource `shouldSatisfy` T.isInfixOf bare-      parseSpec "unmarked" unmarkedSource `shouldBe` parseSpec "marked" markedSource-      errorCodesOf "test/fixtures/reservation-work-optfield.keiro" >>= (`shouldBe` [])-    it "lowers ordering, provisioning, and raw group-key projection" $ do-      spec <- specOf "test/fixtures/reservation-work.keiro"-      case [workqueue | NWorkqueue workqueue <- (.nodes) spec] of-        workqueue : _ -> do-          let modules = scaffoldWorkqueue (defaultContext (spec.context)) workqueue-              queue = generatedTextEndingIn "Queue.hs" modules-              policy = generatedTextEndingIn "QueuePolicy.hs" modules-          queue `shouldSatisfy` T.isInfixOf "groupKeyFor payload = payload.reservationId"-          policy `shouldSatisfy` T.isInfixOf "jobOrdering = FifoThroughput"-          policy `shouldSatisfy` T.isInfixOf "withFifoIndexProvision (standardProvision)"-          policy `shouldSatisfy` T.isInfixOf "data ReservationWorkOutcome"-          policy `shouldSatisfy` T.isInfixOf "jobOutcomeFor :: ReservationWorkOutcome -> JobOutcome"-          policy `shouldNotSatisfy` T.isInfixOf "jobOutcomeFor :: Text -> JobOutcome"-          policy `shouldNotSatisfy` T.isInfixOf "  _ -> Retry"-          firewallBreaches modules `shouldBe` []-        [] -> expectationFailure "reservation-work fixture has no workqueue"--  describe "readmodel (EP-107)" $ do-    it "parses and round-trips first-class read models" $ do-      spec <- specOf "test/fixtures/readmodel.keiro"-      case [readModel | NReadModel readModel <- (.nodes) spec] of-        [subscriptionModel, inlineModel] -> do-          (.name) subscriptionModel `shouldBe` "transfer_decisions"-          (.columns) subscriptionModel-            `shouldBe` [ RmColumn "reservation_id" "text" True,-                         RmColumn "hospital_id" "text" True,-                         RmColumn "status" "text" True,-                         RmColumn "decided_at" "timestamptz" False-                       ]-          legacyReadModelScope subscriptionModel `shouldBe` Just (RmCategory "reservation")-          legacyReadModelFeed subscriptionModel `shouldBe` Just RmSubscription-          legacyReadModelSubscription subscriptionModel `shouldBe` Just "hospital-capacity-transfer-decisions-sub"-          (.name) inlineModel `shouldBe` "subscriptions"-          legacyReadModelScope inlineModel `shouldBe` Nothing-          legacyReadModelFeed inlineModel `shouldBe` Just RmInline-        nodes -> expectationFailure ("expected two readmodel nodes, got " <> show (length nodes))-      parseLanguage4RenderedSpec "in" spec `shouldBe` Right spec-    it "accepts an aggregate projection without a consistency clause" $ do-      spec <- parseInlineSpec "<projection-without-consistency>" projectionWithoutConsistencySpec-      case [projection | NAggregate aggregate <- (.nodes) spec, Just projection <- [(.projection) aggregate]] of-        [projection] -> (.consistency) projection `shouldBe` Nothing-        projections -> expectationFailure ("expected one projection, got " <> show (length projections))-    it "pins the canonical UTF-8 shape digest and runtime identities" $ do-      spec <- specOf "test/fixtures/readmodel.keiro"-      case [readModel | NReadModel readModel <- (.nodes) spec] of-        (subscriptionModel : inlineModel : _) -> do-          canonicalShape subscriptionModel-            `shouldBe` "transfer_decisions|reservation_id:text:req|hospital_id:text:req|status:text:req|decided_at:timestamptz:null"-          deriveShapeHash subscriptionModel `shouldBe` "fnv1a:3717f6d9e3c44bd6"-          deriveShapeHash inlineModel `shouldBe` "fnv1a:f54d9bb2f40a6738"-          registryNameFor (spec.context) subscriptionModel `shouldBe` "hospital-capacity-transfer-decisions"-          subscriptionNameFor (spec.context) subscriptionModel `shouldBe` "hospital-capacity-transfer-decisions-sub"-          subscriptionNameFor "billing" inlineModel `shouldBe` "billing-subscriptions-sub"-        nodes -> expectationFailure ("expected readmodel nodes, got " <> show (length nodes))-    it "accepts the positive readmodel fixture with all references resolved" $ do-      spec <- specOf "test/fixtures/readmodel.keiro"-      validateSpec spec `shouldBe` []-    it "rejects shape drift and unknown SQL column types" $ do-      codes <- errorCodesOf "test/fixtures/readmodel-shape-drift.keiro"-      codes `shouldContain` [RmShapeHashDrift, RmUnknownColumnType]-    it "rejects Strong on inline and standalone projections" $ do-      inlineCodes <- errorCodesOf "test/fixtures/readmodel-strong-inline.keiro"-      inlineCodes `shouldContain` [RmStrongInlineOnly]-      standalone <- specOf "test/fixtures/readmodel-strong-standalone.keiro"-      let diagnostics = validateSpec standalone-      map (.code) diagnostics `shouldContain` [RmStrongInlineOnly, RmProjectionWithoutNode]-      [(.severity) diagnostic | diagnostic <- diagnostics, (.code) diagnostic == RmProjectionWithoutNode]-        `shouldBe` [Warning]-    it "rejects scope without Strong and an unreferenced inline feed" $ do-      scopeCodes <- errorCodesOf "test/fixtures/readmodel-scope-eventual.keiro"-      scopeCodes `shouldContain` [RmScopeWithoutStrong]-      inlineCodes <- errorCodesOf "test/fixtures/readmodel-inline-unreferenced.keiro"-      inlineCodes `shouldContain` [RmInlineFeedUnreferenced]-    it "warns when an inline feed carries an ignored subscription override" $ do-      source <- readTestText "test/fixtures/readmodel.keiro"-      spec <--        parseInlineSpec-          "<inline-subscription>"-          (T.replace "  feed = inline\n" "  feed = inline\n  subscription = \"ignored-subscription\"\n" source)-      diagnosticCodes spec `shouldContain` [RmInlineSubscriptionIgnored]-    it "rejects projection consistency conflicts" $ do-      codes <- errorCodesOf "test/fixtures/readmodel-consistency-conflict.keiro"-      codes `shouldContain` [RmConsistencyConflict]-    it "resolves query read models and validates query consistency" $ do-      codes <- errorCodesOf "test/fixtures/readmodel-query-unresolved.keiro"-      codes `shouldContain` [QueryUnresolvedReadModel, QueryConsistencyInvalid]-    it "resolves dispatch read models and declared dedup columns" $ do-      codes <- errorCodesOf "test/fixtures/readmodel-dispatch-unresolved.keiro"-      codes `shouldContain` [DispatchReadModelUnresolved, DispatchReadModelFieldUnknown]-    it "scaffolds runtime records, rebuild helpers, async wiring, and typed holes" $ do-      spec <- specOf "test/fixtures/readmodel.keiro"-      let ctx = defaultContext (spec.context)-          readModels = [readModel | NReadModel readModel <- (.nodes) spec]-          modules = concatMap (scaffoldReadModel ctx) readModels-          transfer = generatedTextEndingIn "TransferDecisions/ReadModel.hs" modules-          inline = generatedTextEndingIn "Subscriptions/ReadModel.hs" modules-          transferHoles = [(.text) m | m <- modules, "TransferDecisions/ReadModelHoles.hs" `T.isSuffixOf` T.pack ((.path) m)]-      length modules `shouldBe` 6-      length [m | m <- modules, (.kind) m == Generated] `shouldBe` 4-      length [m | m <- modules, (.kind) m == HoleStub] `shouldBe` 2-      firewallBreaches modules `shouldBe` []-      transfer `shouldSatisfy` T.isInfixOf "registerTransferDecisions"-      transfer `shouldSatisfy` T.isInfixOf "Rebuild.startRebuild transferDecisionsReadModel [\"hospital-capacity-transfer-decisions-async\"]"-      transfer `shouldSatisfy` T.isInfixOf "strongScope = CategoryHead \"reservation\""-      transfer `shouldSatisfy` T.isInfixOf "transferDecisionsAsyncProjection"-      inline `shouldSatisfy` T.isInfixOf "Rebuild.startRebuild subscriptionsReadModel []"-      inline `shouldNotSatisfy` T.isInfixOf "AsyncProjection"-      transferHoles `shouldSatisfy` any (T.isInfixOf "RecordedEvent -> Tx.Transaction ()")-    it "threads qualified table and column guidance into aggregate projection holes" $ do-      spec <- specOf "test/fixtures/readmodel.keiro"-      case [aggregate | NAggregate aggregate <- (.nodes) spec] of-        [aggregate] -> do-          let modules = scaffoldAggregate (defaultContext (spec.context)) spec aggregate-              holes = [(.text) m | m <- modules, (.kind) m == HoleStub]-              projection = generatedTextEndingIn "Projection.hs" modules-          holes `shouldSatisfy` any (T.isInfixOf "subscriptionsQualifiedTable")-          holes `shouldSatisfy` any (T.isInfixOf "Table: \"billing\".\"subscriptions\"")-          projection `shouldSatisfy` T.isInfixOf "ReadModelTable.subscriptionsQualifiedTable"-        aggregates -> expectationFailure ("expected one aggregate, got " <> show (length aggregates))-    it "emits runtime-free derivation facts for each read model" $ do-      spec <- specOf "test/fixtures/readmodel.keiro"-      case [readModel | NReadModel readModel <- (.nodes) spec] of-        (subscriptionModel : _) -> do-          let modules = harnessReadModel (defaultContext (spec.context)) spec subscriptionModel-              harnessText = generatedTextEndingIn "ReadModelHarness.hs" modules-          length modules `shouldBe` 1-          firewallBreaches modules `shouldBe` []-          harnessText `shouldNotSatisfy` T.isInfixOf "{-# LANGUAGE OverloadedRecordDot #-}"-          harnessText `shouldSatisfy` T.isInfixOf "import Generated.HospitalCapacity.TransferDecisions.ReadModel (transferDecisionsReadModel, transferDecisionsAsyncProjection)"-          harnessText `shouldSatisfy` T.isInfixOf "(\"shapeHash\", \"fnv1a:3717f6d9e3c44bd6\", T.unpack transferDecisionsReadModel.shapeHash)"-          harnessText `shouldSatisfy` T.isInfixOf "(\"strongScope\", \"CategoryHead reservation\", renderStrongScope transferDecisionsReadModel.strongScope)"-          harnessText `shouldSatisfy` T.isInfixOf "T.unpack transferDecisionsAsyncProjection.name"-          harnessText `shouldSatisfy` T.isInfixOf "runReadModelFacts"-        nodes -> expectationFailure ("expected readmodel nodes, got " <> show (length nodes))--  describe "workflow/operation (EP-6)" $ do-    it "round-trips the workflow spec through parse . pretty" $ do-      input <- readTestText "test/fixtures/workflow.keiro"-      case parseSpec "in" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> parseLanguage4RenderedSpec "in" spec `shouldBe` Right spec-    it "accepts the workflow spec (await<->signal matches, run resolves)" $ do-      codes <- errorCodesOf "test/fixtures/workflow.keiro"-      codes `shouldBe` []-    it "rejects a signal label with no matching await as AwaitSignalMismatch" $ do-      codes <- errorCodesOf "test/fixtures/workflow-signal-mismatch.keiro"-      codes `shouldContain` [AwaitSignalMismatch]-    it "rejects duplicate workflow labels" $ do-      codes <- errorCodesOf "test/fixtures/workflow-dup-label.keiro"-      codes `shouldContain` [WorkflowDuplicateLabel]-    it "rejects unresolved workflow id and sleep fields" $ do-      codes <- errorCodesOf "test/fixtures/workflow-unresolved-fields.keiro"-      codes `shouldContain` [WorkflowIdFieldUnresolved, WorkflowSleepDelayUnresolved]-    it "validates rule domains, totality, case constructors, and bodies" $ do-      unresolved <- errorCodesOf "test/fixtures/rule-bad-domain.keiro"-      unresolved `shouldBe` [RuleDomainUnresolved]-      codes <- errorCodesOf "test/fixtures/rule-not-total.keiro"-      mapM_-        (\expected -> codes `shouldContain` [expected])-        [RuleNotTotal, RuleCaseUnknownCtor, ClockSampled, GuardAtomOutOfScope]-    it "rejects unresolved command operation references" $ do-      codes <- errorCodesOf "test/fixtures/operation-ghost-aggregate.keiro"-      codes `shouldContain` [OperationUnresolvedRef]-    it "rejects a signal value type that differs from its await" $ do-      codes <- errorCodesOf "test/fixtures/operation-signal-value.keiro"-      codes `shouldContain` [AwaitSignalValueMismatch]-    it "round-trips guarded patches and terminal continueAsNew" $ do-      input <- readTestText "test/fixtures/workflow-evolution.keiro"-      case parseSpec "workflow-evolution" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> do-          parseSpec "workflow-evolution" (renderSpec spec) `shouldBe` Right spec-          errorCodes spec `shouldBe` []-    it "rejects duplicate patch ids anywhere in the workflow body" $ do-      codes <- errorCodesOf "test/fixtures/workflow-patch-dup.keiro"-      codes `shouldBe` [WorkflowPatchDuplicate]-    it "rejects non-terminal and nested continueAsNew" $ do-      codes <- errorCodesOf "test/fixtures/workflow-can-mid.keiro"-      codes `shouldBe` [WorkflowContinueAsNewNotTerminal, WorkflowContinueAsNewNotTerminal]-    it "rejects a colon in a patch id with a workflow diagnostic" $ do-      codes <- errorCodesOf "test/fixtures/workflow-patch-colon.keiro"-      codes `shouldBe` [WorkflowPatchIdInvalid]-    it "lowers patch facts and live runtime declarations" $ do-      spec <- specOf "test/fixtures/workflow-evolution.keiro"-      case [workflow | NWorkflow workflow <- (.nodes) spec] of-        [workflow] -> do-          let modules = harnessWorkflow (defaultContext (spec.context)) workflow-              facts = generatedTextEndingIn "WorkflowFacts.hs" modules-              runtime = generatedTextEndingIn "WorkflowRuntime.hs" modules-          facts `shouldSatisfy` T.isInfixOf "patch:fraud-check-v2(step:fraud-check)"-          facts `shouldSatisfy` T.isInfixOf "continueAsNew:RolloverSeed"-          facts `shouldSatisfy` T.isInfixOf "data WorkflowFacts = WorkflowFacts"-          facts `shouldSatisfy` T.isInfixOf "workflowFactBody = [\"step:create-transfer-hold\", \"patch:fraud-check-v2(step:fraud-check)\""-          facts `shouldSatisfy` T.isInfixOf "workflowFactAwaitLabels = [\"reservation-confirmation\"]"-          facts `shouldSatisfy` T.isInfixOf "workflowFactPatchIds = [\"fraud-check-v2\"]"-          runtime `shouldSatisfy` T.isInfixOf "data AwaitBinding = AwaitBinding StepName"-          runtime `shouldSatisfy` T.isInfixOf "reservationConfirmationAwait :: AwaitBinding"-          runtime `shouldSatisfy` T.isInfixOf "reservationConfirmationAwait = AwaitBinding (StepName \"reservation-confirmation\")"-          runtime `shouldSatisfy` T.isInfixOf "allocateDeclaredAwait (AwaitBinding label) = awakeableNamed label"-          runtime `shouldSatisfy` (not . T.isInfixOf "awaitAwakeableId")-          runtime `shouldSatisfy` (not . T.isInfixOf "generation0AwakeableId")-          runtime `shouldSatisfy` (not . T.isInfixOf "Awakeable.Compatibility")-          runtime `shouldSatisfy` T.isInfixOf "declaredPatches = Set.fromList [PatchId \"fraud-check-v2\"]"-          runtime `shouldSatisfy` T.isInfixOf "opts{activePatches = declaredPatches}"-        workflows -> expectationFailure ("expected one workflow, got " <> show (length workflows))-    it "rejects colliding await binding names, including an await nested under a patch" $ do-      spec <--        parseInlineSpec "<workflow-await-binding-collision>" $-          T.unlines-            [ "language keiro-dsl 4",-              "context await-binding-collision",-              "workflow CollisionWorkflow",-              "  name \"collision-workflow\"",-              "  in Input",-              "  out Output",-              "  id from input via idText",-              "  body",-              "    patch nested-proof {",-              "      await foo-bar -> Text",-              "    }",-              "    await foo_bar -> Text"-            ]-      let collisions = [diagnostic | diagnostic <- validateSpec spec, (.code) diagnostic == GeneratedOccurrenceCollision]-      length collisions `shouldBe` 1-      map (.message) collisions `shouldSatisfy` any (T.isInfixOf "fooBarAwait")-      collisions `shouldSatisfy` all (not . null . (.relatedLocations))--  describe "replay impact" $ do-    it "treats new events and transitions as replay-neutral" $ do-      old <- specOf "test/fixtures/reservation.keiro"-      let aggregate = onlyAggregate old-      case ((.events) aggregate, (.transitions) aggregate) of-        (event : _, transition : _) -> do-          let newEvent = eventWithNameAndLoc "ReservationReviewed" noLoc event-              newTransition =-                transition-                  { emits = ["ReservationReviewed"],-                    loc = noLoc-                  }-              new =-                modifyAggregate-                  "Reservation"-                  ( \candidate ->-                      candidate-                        { events = (.events) candidate <> [newEvent],-                          transitions = (.transitions) candidate <> [newTransition]-                        }-                  )-                  old-          replayImpactSpecs old new `shouldBe` ReplayNeutral-        _ -> expectationFailure "reservation fixture must contain an event and transition"--    it "narrows a guard edit to that transition's event types" $ do-      impact <- replayImpactFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-guard-tightened.keiro"-      impact-        `shouldBe` ReplayAffected-          ( Map.singleton-              "Reservation"-              AggregateImpact-                { eventTypes = Set.singleton "TransferReservationCreated",-                  includeSnapshotStreams = True-                }-          )--    it "proves a syntactic guard loosening replay-neutral" $ do-      old <- specOf "test/fixtures/reservation.keiro"-      let loosened =-            modifyAggregate-              "Reservation"-              ( \aggregate ->-                  aggregate-                    { transitions =-                        [ transition {guard = Nothing}-                        | transition <- (.transitions) aggregate-                        ]-                    }-              )-              old-      replayImpactSpecs old loosened `shouldBe` ReplayNeutral--    it "pairs guard-disambiguated siblings independently of both declaration orders" $ do-      base <- specOf "test/fixtures/reservation.keiro"-      let aggregate = onlyAggregate base-      case ((.transitions) aggregate, (.events) aggregate) of-        (prototype : _, firstEvent : secondEvent : _) -> do-          let sibling guardExpression eventName =-                prototype-                  { guard = guardExpression,-                    emits = [eventName],-                    loc = noLoc-                  }-              commandOverride = EPath noLoc CommandRoot ["lifeCriticalOverride"]-              exact = sibling (Just (EAtom (ABool True))) ((.name) firstEvent)-              loosenedOld = sibling (Just commandOverride) ((.name) firstEvent)-              loosenedNew = sibling Nothing ((.name) firstEvent)-              changedOld = sibling (Just (ECmp OpEq commandOverride (ELiteral noLoc (LiteralBool False)))) ((.name) secondEvent)-              changedNew = sibling (Just (ECmp OpEq commandOverride (ELiteral noLoc (LiteralBool True)))) ((.name) firstEvent)-              oldSiblings = [exact, loosenedOld, changedOld]-              newSiblings = [exact, loosenedNew, changedNew]-              withTransitions transitions =-                modifyAggregate-                  ((.name) aggregate)-                  (\candidate -> candidate {transitions = transitions})-                  base-              impacts =-                [ replayImpactSpecs (withTransitions oldOrder) (withTransitions newOrder)-                | oldOrder <- permutations oldSiblings,-                  newOrder <- permutations newSiblings-                ]-          case impacts of-            firstImpact : remainingImpacts -> do-              remainingImpacts `shouldSatisfy` all (== firstImpact)-              firstImpact `shouldSatisfy` (/= ReplayNeutral)-            [] -> expectationFailure "permutations unexpectedly produced no replay comparisons"-        _ -> expectationFailure "reservation fixture must contain one transition and two events"--    it "marks every existing event when the aggregate wire convention changes" $ do-      impact <- replayImpactFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-wire.keiro"-      case impact of-        ReplayAffected aggregates ->-          (.eventTypes) <$> Map.lookup "Reservation" aggregates-            `shouldBe` Just (Set.fromList ["TransferReservationCreated", "TransferReservationConfirmed"])-        ReplayNeutral -> expectationFailure "expected a wire-clause replay impact"--    it "includes snapshot streams when a write expression changes" $ do-      impact <- replayImpactFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-foldchange.keiro"-      case impact of-        ReplayAffected aggregates ->-          (.includeSnapshotStreams) <$> Map.lookup "Reservation" aggregates-            `shouldBe` Just True-        ReplayNeutral -> expectationFailure "expected a fold replay impact"--    it "detects codec evolution and ignores formatting-only rewrites" $ do-      changed <- replayImpactFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-v2.keiro"-      changed `shouldSatisfy` (/= ReplayNeutral)-      old <- specOf "test/fixtures/reservation.keiro"-      formatted <- shouldParseStableRenderedSpec "<formatted>" old-      replayImpactSpecs old formatted `shouldBe` ReplayNeutral--    it "names mapped nested event and snapshot roots while ignoring Haskell-only changes" $ do-      nested <- replayImpactFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-nested-propagation.keiro"-      case nested of-        ReplayAffected aggregates ->-          Map.lookup "Catalog" aggregates-            `shouldBe` Just AggregateImpact {eventTypes = Set.singleton "ArtifactObserved", includeSnapshotStreams = True}-        ReplayNeutral -> expectationFailure "expected nested mapped wire change to affect replay"-      sourceOnly <- replayImpactFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-haskell-rename.keiro"-      sourceOnly `shouldBe` ReplayNeutral--    it "generates one context target for every aggregate, including the process saga" $ do-      spec <- specOf "test/fixtures/surge-service.keiro"-      case scaffoldReplayAudit (defaultContext (spec.context)) spec of-        [assembly] -> do-          (.path) assembly `shouldBe` "Generated/SurgeDemo/ReplayAudit.hs"-          (.text) assembly `shouldSatisfy` T.isInfixOf "Hospital.hospitalEventStream"-          (.text) assembly `shouldSatisfy` T.isInfixOf "Surge.surgeEventStream"-          T.count "      AuditTarget" ((.text) assembly) `shouldBe` 2-        assemblies -> expectationFailure ("expected one replay-audit assembly, got " <> show (length assemblies))--  describe "diff (evolution classification)" $ do-    it "covers every node family exactly once and explains exclusions" $ do-      sort (map fst familyRegistry) `shouldBe` ([minBound .. maxBound] :: [NodeFamily])-      [reason | (_, OutOfDiffScope reason) <- familyRegistry, T.null reason] `shouldBe` []-    it "reports checked mapped consumers separately from compatibility findings" $ do-      old <- specOf "test/fixtures/semantic-impact.keiro"-      let new = mapMappedStructural "NestedPayload" changeMappedCanonical old-          changes = diffSpecs old new-          impact = CheckedDiff.mappedSemanticImpact old new-          rendered = T.unlines (renderSemanticImpact impact)-          encoded = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReportWithSemanticImpact defaultGate changes impact)))-      map (.declaration) impact `shouldBe` [MappedKey "NestedPayload"]-      rendered `shouldSatisfy` T.isInfixOf "previous aggregate consumers: Alpha"-      rendered `shouldSatisfy` T.isInfixOf "current aggregate consumers:  Alpha"-      rendered `shouldSatisfy` T.isInfixOf "service-conformance: impacted"-      rendered `shouldSatisfy` (not . T.isInfixOf "Beta")-      encoded `shouldSatisfy` T.isInfixOf "\"semanticImpact\""-      encoded `shouldSatisfy` T.isInfixOf "\"previousConsumers\":[\"Alpha\"]"-      let reordered = old {mapped = reverse ((.mapped) old), nodes = reverse ((.nodes) old)}-      CheckedDiff.mappedSemanticImpact old reordered `shouldBe` []-    it "reports added, removed, and unused mapped declarations without inventing aggregate consumers" $ do-      let declarationA = completeStructural "A" (recordShape [TText])-          declarationB = completeStructural "B" (recordShape [TInt])-          onlyA = mappedSpec [declarationA]-          withB = mappedSpec [declarationA, declarationB]-          added = CheckedDiff.mappedSemanticImpact onlyA withB-          removed = CheckedDiff.mappedSemanticImpact withB onlyA-          expectedB = MappedKey "B"-      map (.declaration) added `shouldBe` [expectedB]-      map (.previousConsumers) added `shouldBe` [Set.empty]-      map (.currentConsumers) added `shouldBe` [Set.empty]-      map (.serviceConformance) added `shouldBe` [True]-      map (.declaration) removed `shouldBe` [expectedB]-      map (.previousConsumers) removed `shouldBe` [Set.empty]-      map (.currentConsumers) removed `shouldBe` [Set.empty]-      map (.serviceConformance) removed `shouldBe` [True]--      old <- specOf "test/fixtures/semantic-impact.keiro"-      let changed = mapMappedStructural "UnusedPayload" changeMappedCanonical old-          unusedImpact = CheckedDiff.mappedSemanticImpact old changed-      map (.declaration) unusedImpact `shouldBe` [MappedKey "UnusedPayload"]-      map (.previousConsumers) unusedImpact `shouldBe` [Set.empty]-      map (.currentConsumers) unusedImpact `shouldBe` [Set.empty]-      map (.serviceConformance) unusedImpact `shouldBe` [True]-    it "derives every exercised headline from its vector under the default gate" $ do-      changes <--        concat-          <$> mapM-            (uncurry diffFixtures)-            [ ("test/fixtures/reservation.keiro", "test/fixtures/reservation-fieldadd.keiro"),-              ("test/fixtures/reservation.keiro", "test/fixtures/reservation-v2.keiro"),-              ("test/fixtures/reservation.keiro", "test/fixtures/reservation-enumadd.keiro"),-              ("test/fixtures/contract.keiro", "test/fixtures/contract-fieldadd.keiro"),-              ("test/fixtures/reservation-work.keiro", "test/fixtures/reservation-work-rename.keiro")-            ]-      forM_ changes $ \change ->-        do-          deriveLabel defaultGate ((kindOfChange change).vector)-            `shouldBe` labelOfChange change-          gatedBreaking defaultGate change `shouldBe` isBreaking change-    it "never removes a breaking result when the gate grows" $-      property $-        forAll genCompatibilityVector $ \compatibility ->-          forAll genSurfaceSet $ \gate ->-            forAll genSurfaceSet $ \extra ->-              deriveLabel gate compatibility-                == LabelBreaking-                  ==> deriveLabel (gate <> extra) compatibility-                == LabelBreaking-    it "renders the consumer-neutral matrix with separate private, snapshot, and public surfaces" $ do-      changes <- diffFixtures "test/fixtures/compatibility-vector-old.keiro" "test/fixtures/compatibility-vector-new.keiro"-      let rendered = T.intercalate "\n" (map renderFinding changes)-          explained = T.intercalate "\n" (map renderExplainBlock changes)-          reportJson = T.pack (show (Aeson.toJSON (diffReport defaultGate changes)))-      assertMatchesGolden "test/fixtures/compatibility-vector.diff.golden" rendered-      rendered `shouldSatisfy` T.isInfixOf "Reservation.event.TransferReservationCreated.patientAcuity"-      rendered `shouldSatisfy` T.isInfixOf "old-binary-read-new-events=breaking"-      rendered `shouldSatisfy` T.isInfixOf "snapshot-hydration=advisory"-      rendered `shouldSatisfy` T.isInfixOf "public-consumer=breaking"-      explained `shouldSatisfy` T.isInfixOf "invalidate and rebuild snapshots"-      reportJson `shouldSatisfy` T.isInfixOf "keiro-dsl/diff-report/1"-      reportJson `shouldSatisfy` T.isInfixOf "Reservation.event.TransferReservationCreated.patientAcuity"-      let eventEnumFindings =-            [ change-            | change@(Advisory kind) <- changes,-              (.code) kind == EnumCtorAdded,-              verdictFor OldBinaryReadNewEvents (kind.vector) == VBreaking-            ]-      eventEnumFindings `shouldSatisfy` all (not . gatedBreaking defaultGate)-      eventEnumFindings `shouldSatisfy` all (gatedBreaking (gateWith [OldBinaryReadNewEvents]))-      forM_ changes $ \change ->-        remediationFor ((kindOfChange change).context) ((.code) (kindOfChange change))-          `shouldSatisfy` (not . null)-    it "rejects unknown --gate values with the valid surface list" $ do-      parseSurfaceName "mystery-surface"-        `shouldSatisfy` either (T.isInfixOf "old-binary-read-new-events" . T.pack) (const False)-    it "covers the mapped evolution matrix with stable codes and non-empty remedies" $ do-      let cases =-            [ ("consumer-types-fieldadd-default.keiro", MappedFieldAddedWithDefault),-              ("consumer-types-fieldadd-nodefault.keiro", MappedFieldAddedNoDefault),-              ("consumer-types-fieldremove.keiro", MappedFieldRemoved),-              ("consumer-types-wirekey.keiro", MappedWireKeyChanged),-              ("consumer-types-haskell-rename.keiro", MappedHaskellSourceChanged),-              ("consumer-types-binding-change.keiro", MappedBindingChanged),-              ("consumer-types-fixtures-change.keiro", MappedFixturesChanged),-              ("consumer-types-initial-change.keiro", MappedInitialChanged),-              ("consumer-types-armadd.keiro", MappedArmAdded),-              ("consumer-types-tagchange.keiro", MappedArmTagChanged),-              ("consumer-types-enumadd.keiro", MappedEnumValueAdded),-              ("consumer-types-enumremove.keiro", MappedEnumValueRemoved),-              ("consumer-types-enumspelling.keiro", MappedEnumSpellingChanged),-              ("consumer-types-encoding.keiro", MappedUnionEncodingChanged),-              ("consumer-types-opaque-version.keiro", MappedOpaqueCodecChanged),-              ("consumer-types-mode-cross.keiro", MappedModeCrossed),-              ("consumer-types-nested-propagation.keiro", MappedArmTagChanged)-            ]-      forM_ cases $ \(fixture, expectedCode) -> do-        changes <- diffFixtures "test/fixtures/consumer-types.keiro" ("test/fixtures/" <> fixture)-        map ((.code) . kindOfChange) changes `shouldContain` [expectedCode]-        forM_ changes $ \change ->-          remediationFor ((kindOfChange change).context) ((.code) (kindOfChange change))-            `shouldSatisfy` (not . null)-    it "separates mapped event migration, snapshot invalidation, and directional rollout" $ do-      breakingAdd <- diffFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-fieldadd-nodefault.keiro"-      let noDefault = [change | change <- breakingAdd, (.code) (kindOfChange change) == MappedFieldAddedNoDefault]-      [(.facet) kind | Breaking kind <- noDefault] `shouldContain` ["mapped-event"]-      [(.facet) kind | Advisory kind <- noDefault] `shouldContain` ["mapped-register"]-      defaulted <- diffFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-fieldadd-default.keiro"-      [change | change <- defaulted, isBreaking change] `shouldBe` []-      let eventDefaults = [kind | Advisory kind <- defaulted, (.code) kind == MappedFieldAddedWithDefault, (.facet) kind == "mapped-event"]-      eventDefaults `shouldSatisfy` any ((== VBreaking) . verdictFor OldBinaryReadNewEvents . (.vector))-      armAdded <- diffFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-armadd.keiro"-      [change | change <- armAdded, isBreaking change] `shouldBe` []-      [kind | Advisory kind <- armAdded, (.code) kind == MappedArmAdded, (.facet) kind == "mapped-event"]-        `shouldSatisfy` any ((== VBreaking) . verdictFor OldBinaryReadNewEvents . (.vector))-    it "classifies mapped queue history without borrowing event or snapshot surfaces" $ do-      source <- mappedConsumerSurfaceSource-      base <- parseInlineSpec "<mapped-queue-diff-old>" source-      let candidate = mapArtifactNamedField "key" (wireFieldWithKey "artifact_key_v2") base-          queueFindings =-            [ kind-            | change <- diffSpecs base candidate,-              let kind = kindOfChange change,-              (.facet) kind == "mapped-workqueue"-            ]-      queueFindings `shouldSatisfy` (not . null)-      forM_ queueFindings $ \kind -> do-        verdictFor PrivateHistoryRead (kind.vector) `shouldBe` VNotApplicable-        verdictFor OldBinaryReadNewEvents (kind.vector) `shouldBe` VNotApplicable-        verdictFor SnapshotHydration (kind.vector) `shouldBe` VNotApplicable-        verdictFor ConsumerBuild (kind.vector) `shouldBe` VBreaking-        (.rollout) (kind.vector) `shouldBe` Set.fromList [RolloutWorkersFirst, RolloutDrainRequired]-        (.mappedPersistedImpact) kind-          `shouldBe` Just (MappedPersistedImpact (WorkqueueHistory "ArtifactJobs") VBreaking)-        (.detail) kind `shouldSatisfy` T.isInfixOf "schema-version-1 history"-        remediationFor (kind.context) ((.code) kind)-          `shouldSatisfy` all (`elem` [RemedyDeploymentOrder RolloutWorkersFirst, RemedyDrainWorkqueue, RemedyTransitionalQueueCodec, RemedyRecompileConsumers, RemedyRunConformance])-    it "propagates a nested mapped leaf to complete command, event, and register paths" $ do-      changes <- diffFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-nested-propagation.keiro"-      let subjects =-            [ (.subject) kind-            | change <- changes,-              let kind = kindOfChange change,-              (.code) kind == MappedArmTagChanged-            ]-      subjects-        `shouldContain` [ "Catalog command ObserveArtifact .artifact : ArtifactInfo .location : ArtifactLocation .arm RepoPath[\"repository_path\"]",-                          "Catalog event ArtifactObserved .artifact : ArtifactInfo .location : ArtifactLocation .arm RepoPath[\"repository_path\"]",-                          "Catalog register currentArtifact : ArtifactInfo .location : ArtifactLocation .arm RepoPath[\"repository_path\"]"-                        ]-    it "classifies every remaining mapped field and declaration evolution row" $ do-      base <- specOf "test/fixtures/consumer-types.keiro"-      let mutationCodes =-            [ (mapArtifactNamedField "key" (wireFieldWithValueType TInt) base, MappedFieldTypeChanged),-              (mapArtifactNamedField "key" (wireFieldWithPresenceAndDefault POptional (Just (OmText ""))) base, MappedPresenceChanged),-              (mapArtifactNamedField "key" (wireFieldWithValueType (TOptional TText)) base, MappedNullabilityChanged),-              (mapArtifactNamedField "description" (wireFieldWithOnMissing Nothing) base, MappedDefaultRemoved),-              (mapArtifactNamedField "count" (wireFieldWithOnMissing (Just (OmInt 1))) base, MappedDefaultChanged),-              (mapMappedStructural "ArtifactInfo" renameMappedRecordConstructor base, MappedRecordConstructorChanged),-              (mapMappedStructural "ArtifactInfo" changeMappedCanonical base, MappedCanonicalTypeChanged)-            ]-      forM_ mutationCodes $ \(candidate, expectedCode) ->-        map ((.code) . kindOfChange) (diffSpecs base candidate) `shouldContain` [expectedCode]-      let declarationA = completeStructural "A" (recordShape [TText])-          declarationB = completeStructural "B" (recordShape [TInt])-          onlyA = mappedSpec [declarationA]-          withB = mappedSpec [declarationA, declarationB]-      map ((.code) . kindOfChange) (diffSpecs onlyA withB) `shouldContain` [MappedDeclAdded]-      map ((.code) . kindOfChange) (diffSpecs withB onlyA) `shouldContain` [MappedDeclRemoved]-      diffSpecs base (mapArtifactNamedField "key" (wireFieldWithHaskell "renamedKey") base)-        `shouldSatisfy` \case-          [Advisory change] -> (.code) change == GeneratedHaskellNameChanged-          _ -> False-    it "visits every mapped wire mutation and reports every complete root path" $ do-      base <- specOf "test/fixtures/consumer-types.keiro"-      let mutations = mappedWireMutations base-      mutations `shouldSatisfy` (not . null)-      visited <- fmap Set.unions . forM mutations $ \mutation -> do-        let changes =-              [ change-              | change <- diffSpecs base ((.mmCandidate) mutation),-                (.code) (kindOfChange change) == (.mmCode) mutation-              ]-            actualSubjects = Set.fromList (map ((.subject) . kindOfChange) changes)-        changes `shouldSatisfy` any (not . isAdditiveChange)-        actualSubjects `shouldBe` (.mmExpectedSubjects) mutation-        pure actualSubjects-      visited `shouldBe` Set.unions (map (.mmExpectedSubjects) mutations)-    it "reports the exact ingredient code when every required mapped fact is deleted" $ do-      base <- specOf "test/fixtures/consumer-types.keiro"-      forM_ (mappedIngredientMutations base) $ \(candidate, expectedCode) ->-        errorCodes candidate `shouldContain` [expectedCode]-    it "classifies a field added without a version bump as BREAKING" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-fieldadd.keiro"-      any isBreaking cs `shouldBe` True-      [(.code) k | Breaking k <- cs] `shouldContain` [EvtFieldAddedWithoutBump]-    it "classifies the same field wrapped as v2 + upcaster as ADDITIVE" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-v2.keiro"-      any isBreaking cs `shouldBe` False-      [ck | Additive ck <- cs] `shouldSatisfy` any ((== "TransferReservationCreated") . (.subject))-    it "reports no breaking change when the spec is unchanged" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation.keiro"-      any isBreaking cs `shouldBe` False-    it "classifies a direct event field type change as EvtFieldTypeChanged" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-fieldtype.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [EvtFieldTypeChanged]-    it "resolves fields(Command) before comparing event field types" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-cmdfieldtype.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [EvtFieldTypeChanged]-    it "uses EvtFieldRemovedSameVersion for an unchanged-version removal" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-fieldremove.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [EvtFieldRemovedSameVersion]-    it "classifies selector aliases as build-only and wire aliases as replay-affecting" $ do-      let sourceFor field =-            T.unlines-              [ "language keiro-dsl 4",-                "context field-alias-diff",-                "aggregate AliasDiff",-                "  regs",-                "  states Open",-                "  command Observe { " <> field <> " }",-                "  event Observed = fields(Observe)",-                "  wire kind=ctorName fields=camelCase schemaVersion=1"-              ]-      base <- checkedServiceFromText "field-alias-diff-base.keiro" (sourceFor "region:Text")-      selectorAlias <- checkedServiceFromText "field-alias-diff-selector.keiro" (sourceFor "region haskell serviceRegion:Text")-      wireAlias <- checkedServiceFromText "field-alias-diff-wire.keiro" (sourceFor "region as \"region_code\":Text")-      let selectorChanges = diffServices base selectorAlias-          wireChanges = diffServices base wireAlias-          selectorFindings = [finding | Advisory finding <- selectorChanges, (.code) finding == GeneratedHaskellNameChanged]-          wireFindings = [finding | Breaking finding <- wireChanges, (.code) finding == EvtFieldWireKeyChanged]-      selectorChanges `shouldSatisfy` all (not . isBreaking)-      map (.facet) selectorFindings `shouldContain` ["command-field-selector", "event-field-selector"]-      map (verdictFor ConsumerBuild . (.vector)) selectorFindings `shouldSatisfy` all (== VAdvisory)-      resolvedFold (ReplayImpact.replayImpactServices base selectorAlias) `shouldBe` ReplayNeutral-      case wireFindings of-        [finding] -> do-          (.subject) finding `shouldBe` "Observed.region"-          verdictFor PrivateHistoryRead (finding.vector) `shouldBe` VBreaking-          verdictFor OldBinaryReadNewEvents (finding.vector) `shouldBe` VBreaking-          (.detail) finding `shouldSatisfy` T.isInfixOf "'region' -> 'region_code'"-        findings -> expectationFailure ("expected one event wire-key finding, got " <> show findings)-      resolvedFold (ReplayImpact.replayImpactServices base wireAlias)-        `shouldSatisfy` \case-          ReplayAffected impacts ->-            maybe False ((== Set.singleton "Observed") . (.eventTypes)) (Map.lookup "AliasDiff" impacts)-          ReplayNeutral -> False-    it "retains event selector advisories across a legal version bump" $ do-      let sourceFor eventDeclaration =-            T.unlines-              [ "language keiro-dsl 4",-                "context field-alias-version-diff",-                "aggregate AliasVersionDiff",-                "  regs",-                "  states Open",-                "  command Observe {}",-                eventDeclaration-              ]-      base <- checkedServiceFromText "field-alias-version-base.keiro" (sourceFor "  event Observed { region:Text }")-      bumped <--        checkedServiceFromText-          "field-alias-version-bumped.keiro"-          (sourceFor "  event Observed v2 { region haskell serviceRegion:Text }\n    upcast from v1 = HOLE")-      let changes = diffServices base bumped-          selectorFindings = [finding | Advisory finding <- changes, (.code) finding == GeneratedHaskellNameChanged]-      [(.code) finding | Additive finding <- changes] `shouldContain` [VersionBumped]-      map (.facet) selectorFindings `shouldBe` ["event-field-selector"]-      map (verdictFor ConsumerBuild . (.vector)) selectorFindings `shouldBe` [VAdvisory]-    it "classifies contract selector aliases separately from public wire changes" $ do-      let sourceFor field =-            T.unlines-              [ "language keiro-dsl 4",-                "context contract-field-alias-diff",-                "contract emergency {",-                "  schemaVersion 1",-                "  discriminator messageType",-                "  topic events \"emergency.events\"",-                "  event IncidentDeclared on events {",-                "    " <> field,-                "  }",-                "}"-              ]-      base <- checkedServiceFromText "contract-field-alias-base.keiro" (sourceFor "region: text")-      selectorAlias <- checkedServiceFromText "contract-field-alias-selector.keiro" (sourceFor "region haskell serviceRegion: text")-      wireAlias <- checkedServiceFromText "contract-field-alias-wire.keiro" (sourceFor "region as \"region_code\": text")-      let selectorChanges = diffServices base selectorAlias-          wireChanges = diffServices base wireAlias-      selectorChanges `shouldSatisfy` \case-        [Advisory finding] ->-          (.code) finding == GeneratedHaskellNameChanged-            && (.facet) finding == "contract-field-selector"-            && verdictFor ConsumerBuild (finding.vector) == VAdvisory-        _ -> False-      case [finding | Breaking finding <- wireChanges, (.code) finding == ContractFieldChanged] of-        [finding] -> do-          verdictFor PublicConsumer (finding.vector) `shouldBe` VBreaking-          (.rollout) (finding.vector) `shouldBe` Set.singleton RolloutProducerLast-          (.detail) finding `shouldSatisfy` T.isInfixOf "consumer-first rollout"-        findings -> expectationFailure ("expected one contract wire-key finding, got " <> show findings)-    it "keeps an alias-free field rename on the existing add/remove path" $ do-      let sourceFor field =-            T.unlines-              [ "language keiro-dsl 4",-                "context field-rename-diff",-                "aggregate RenameDiff",-                "  regs",-                "  states Open",-                "  event Renamed { " <> field <> ":Text }",-                "  wire kind=ctorName fields=camelCase schemaVersion=1"-              ]-      old <- checkedServiceFromText "field-rename-old.keiro" (sourceFor "region")-      new <- checkedServiceFromText "field-rename-new.keiro" (sourceFor "zone")-      let changes = diffServices old new-      [(.code) finding | Breaking finding <- changes]-        `shouldContain` [EvtFieldAddedWithoutBump, EvtFieldRemovedSameVersion]-      [finding | Advisory finding <- changes, (.code) finding == GeneratedHaskellNameChanged]-        `shouldBe` []-    it "uses EvtVersionDecreased for a version decrease" $ do-      cs <- diffFixtures "test/fixtures/reservation-v2.keiro" "test/fixtures/reservation.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [EvtVersionDecreased]-    it "rejects a v1 to v3 jump whose only upcaster starts at v2" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-v3-dangling.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [EvtVersionMissingUpcaster]-    it "classifies a vanished historical upcaster rung as UpcasterChainGap" $ do-      cs <- diffFixtures "test/fixtures/reservation-v2.keiro" "test/fixtures/reservation-chain-gap.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [UpcasterChainGap]-    it "classifies an enum constructor removal as EnumCtorRemoved" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-enumdrop.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [EnumCtorRemoved]-    it "classifies an enum wire-spelling change as EnumWireSpellingChanged" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-enumwire.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [EnumWireSpellingChanged]-    it "classifies an enum constructor addition per use site as advisory" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-enumadd.keiro"-      any isBreaking cs `shouldBe` False-      let enumFindings = [k | Advisory k <- cs, (.code) k == EnumCtorAdded]-      [(.subject) k | k <- enumFindings] `shouldContain` ["BlackTag"]-      [verdictFor SnapshotHydration (k.vector) | k <- enumFindings]-        `shouldContain` [VAdvisory]-    it "classifies an effective wire convention change as WireSpecChanged" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-wire.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [WireSpecChanged]-    it "advises when the aggregate fold surface changes" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-foldchange.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldContain` [AggFoldSurfaceChanged]-    it "advises on hazardous deprecation and reports un-deprecation" $ do-      deprecated <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-deprecated.keiro"-      any isBreaking deprecated `shouldBe` False-      [(.code) k | Advisory k <- deprecated] `shouldContain` [DeprecatedEventReplayHazard]-      restored <- diffFixtures "test/fixtures/reservation-deprecated.keiro" "test/fixtures/reservation.keiro"-      any isAdvisory restored `shouldBe` True-      [(.code) k | Advisory k <- restored] `shouldContain` [EventUndeprecated]-    it "recognises replay-only deprecation as a replay-safe retirement cutover" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-deprecated-replay-only.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldContain` [EventRetirementInProgress]-      [(.code) k | Advisory k <- cs] `shouldNotContain` [DeprecatedEventReplayHazard]-    it "advises when event retirement starts" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-retiring.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldContain` [EventRetirementInProgress]-    it "does not recommend decode-only deprecation for an event removal" $ do-      old <- specOf "test/fixtures/reservation.keiro"-      let new =-            specWithNodes-              [ case node of-                  NAggregate aggregate ->-                    NAggregate-                      aggregate-                        { events =-                            [ event-                            | event <- (.events) aggregate,-                              (.name) event /= "TransferReservationConfirmed"-                            ],-                          transitions =-                            [ transition {emits = filter (/= "TransferReservationConfirmed") ((.emits) transition)}-                            | transition <- (.transitions) aggregate-                            ]-                        }-                  _ -> node-              | node <- old.nodes-              ]-              old-          removals = [change | change@(Breaking kind) <- diffSpecs old new, (.code) kind == EvtRemovedNotDeprecated]-      removals `shouldSatisfy` (not . null)-      [(.detail) kind | Breaking kind <- removals]-        `shouldSatisfy` all (not . T.isInfixOf "so old payloads still decode")-    it "prints a paste-ready replay-only twin when a guard tightens (plan 143)" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-guard-tightened.keiro"-      any isBreaking cs `shouldBe` False-      let advisories = [k | Advisory k <- cs, (.code) k == AggGuardTightened]-      map (.subject) advisories `shouldBe` ["Unrequested -- RequestTransferReservation"]-      advisoryDetail <- case advisories of-        [k] -> pure ((.detail) k)-        other -> expectationFailure ("expected one advisory, got " <> show other) >> pure ""-      advisoryDetail `shouldSatisfy` T.isInfixOf "replay-only Unrequested -- RequestTransferReservation"-      -- The printed twin is paste-ready: appended to the new spec it-      -- parses, validates without errors, and silences the advisory.-      tightened <- readTestText "test/fixtures/reservation-guard-tightened.keiro"-      let twinText = snd (T.breakOnEnd "\n\n" advisoryDetail)-          pasted = tightened <> "\n" <> twinText <> "\n"-      case parseSpec "<pasted-twin>" pasted of-        Left err -> expectationFailure (T.unpack err)-        Right pastedSpec -> do-          [(.code) d | d <- validateSpec pastedSpec, (.severity) d == Error] `shouldBe` []-          base <- specOf "test/fixtures/reservation.keiro"-          [k | Advisory k <- diffSpecs base pastedSpec, (.code) k == AggGuardTightened]-            `shouldBe` []-    it "omits the twin advisory when the twin is already present (plan 143)" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-guard-tightened-twin.keiro"-      [k | Advisory k <- cs, (.code) k == AggGuardTightened] `shouldBe` []-    it "classifies a removed contract event as ContractEventRemoved" $ do-      cs <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-eventdrop.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [ContractEventRemoved]-    it "classifies contract field type changes and unversioned additions as ContractFieldChanged" $ do-      changed <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-fieldtype.keiro"-      [(.code) k | Breaking k <- changed] `shouldContain` [ContractFieldChanged]-      added <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-fieldadd.keiro"-      [(.code) k | Breaking k <- added] `shouldContain` [ContractFieldChanged]-    it "freezes the contract TypeID diff report byte contract and rollout" $ do-      let source versionNumber prefix =-            T.unlines-              [ "language keiro-dsl " <> T.pack (show versionNumber),-                "context hospital-capacity",-                "contract emergency {",-                "  schemaVersion 1",-                "  discriminator messageType",-                "  topic incidentEvents \"emergency.incident.events\"",-                "  event IncidentTransferNeedDeclared on incidentEvents {",-                "    incidentId: typeid \"" <> prefix <> "\"",-                "  }",-                "}"-              ]-          checked name input = case parseSource name input of-            Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-            Right parsed -> pure (checkedSource parsed)-      v1 <- checked "contract-typeid-v1.keiro" (source (1 :: Int) "inc")-      v3 <- checked "contract-typeid-v3.keiro" (source (3 :: Int) "inc")-      v4 <- checked "contract-typeid-v4.keiro" (source (4 :: Int) "inc")-      v4Edited <- checked "contract-typeid-v4-edited.keiro" (source (4 :: Int) "rsv")-      let changes = diffServices v3 v4-          textGolden = T.intercalate "\n" (map renderFinding changes)-          jsonGolden = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReport defaultGate changes)))-          findings = [kind | Breaking kind <- changes, (.code) kind == ContractTypeIdDomainChanged]-      assertMatchesGolden "test/fixtures/contract-typeid-domain.diff.golden" textGolden-      assertMatchesByteGolden "test/fixtures/contract-typeid-domain.diff.json.golden" (TextEncoding.encodeUtf8 jsonGolden)-      case findings of-        [finding] -> do-          verdictFor PublicConsumer (finding.vector) `shouldBe` VBreaking-          verdictFor ConsumerBuild (finding.vector) `shouldBe` VBreaking-          [verdictFor surface (finding.vector) | surface <- [PrivateHistoryRead, OldBinaryReadNewEvents, SnapshotHydration, PersistedIdentity]]-            `shouldBe` replicate 4 VNotApplicable-          (.rollout) (finding.vector) `shouldBe` Set.fromList [RolloutDrainRequired, RolloutProducerFirst]-          deriveLabel (Set.singleton PublicConsumer) (finding.vector) `shouldBe` LabelBreaking-          deriveLabel (Set.singleton ConsumerBuild) (finding.vector) `shouldBe` LabelBreaking-          remediationFor (finding.context) ((.code) finding)-            `shouldBe` RemedyEmitContractTypeIdDomain :| [RemedyDrainLegacyInvalidContractMessages, RemedyRescaffoldContractConsumers, RemedyRunContractConformance]-        values -> expectationFailure ("expected one contract TypeID-domain finding, got " <> show (length values))-      [kind | change <- diffServices v1 v3, let { kind = kindOfChange change }, (.code) kind == ContractTypeIdDomainChanged] `shouldBe` []-      [kind | change <- diffServices v4 v4, let { kind = kindOfChange change }, (.code) kind == ContractTypeIdDomainChanged] `shouldBe` []-      let edited = diffServices v3 v4Edited-      map ((.code) . kindOfChange) edited `shouldContain` [ContractFieldChanged]-      [kind | change <- edited, let { kind = kindOfChange change }, (.code) kind == ContractTypeIdDomainChanged] `shouldBe` []-    it "reports a field addition with a contract version bump as an advisory" $ do-      cs <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-bump-fieldadd.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldContain` [ContractSchemaVersionBumped]-    it "classifies a contract schema version decrease separately" $ do-      cs <- diffFixtures "test/fixtures/contract-bump-fieldadd.keiro" "test/fixtures/contract.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [ContractSchemaVersionDecreased]-    it "classifies contract topic and discriminator changes separately" $ do-      topic <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-topic.keiro"-      [(.code) k | Breaking k <- topic] `shouldContain` [ContractTopicChanged]-      discriminatorChanges <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-discriminator.keiro"-      [(.code) k | Breaking k <- discriminatorChanges] `shouldContain` [ContractDiscriminatorChanged]-    it "classifies a new contract event as additive" $ do-      cs <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-eventadd.keiro"-      any isBreaking cs `shouldBe` False-      [(.subject) k | Additive k <- cs] `shouldContain` ["IncidentTransferNeedCancelled"]-    it "classifies workqueue wire names, types, and required additions as WqPayloadFieldChanged" $ do-      wire <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-wirename.keiro"-      [(.code) k | Breaking k <- wire] `shouldContain` [WqPayloadFieldChanged]-      fieldTypeChange <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-fieldtype.keiro"-      [(.code) k | Breaking k <- fieldTypeChange] `shouldContain` [WqPayloadFieldChanged]-      required <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-reqfield.keiro"-      [(.code) k | Breaking k <- required] `shouldContain` [WqPayloadFieldChanged]-    -- Adding a payload field is breaking however it is spelled. Generated-    -- decoders read every field with `o .:`, so a job already queued under the-    -- old shape fails to decode against the new one — the "additive, optional-    -- field" classification this test previously asserted described a decoder-    -- that was never generated. See ExecPlan 199.-    it "classifies any new workqueue payload field as breaking for queued jobs" $ do-      cs <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-optfield.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [WqPayloadFieldChanged]-      [(.subject) k | Breaking k <- cs] `shouldContain` ["note"]-      [(.detail) k | Breaking k <- cs, (.subject) k == "note"]-        `shouldSatisfy` any (T.isInfixOf "queued jobs do not contain it")-    it "classifies workqueue ordering changes as breaking delivery-contract changes" $ do-      cs <- diffFixtures "test/fixtures/workqueue-policy-base.keiro" "test/fixtures/workqueue-ordering-change.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [WqOrderingChanged]-      [(.detail) k | Breaking k <- cs, (.code) k == WqOrderingChanged]-        `shouldSatisfy` any (T.isInfixOf "delivery-order contract")-    it "classifies workqueue provision changes as operational migrations" $ do-      cs <- diffFixtures "test/fixtures/workqueue-policy-base.keiro" "test/fixtures/workqueue-provision-change.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [WqProvisionChanged]-      [(.detail) k | Breaking k <- cs, (.code) k == WqProvisionChanged]-        `shouldSatisfy` any (T.isInfixOf "migrate the existing queue operationally")-    it "classifies workqueue group-key changes as breaking repartitioning" $ do-      cs <- diffFixtures "test/fixtures/workqueue-policy-base.keiro" "test/fixtures/workqueue-group-key-change.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [WqGroupKeyChanged]-      [(.detail) k | Breaking k <- cs, (.code) k == WqGroupKeyChanged]-        `shouldSatisfy` any (T.isInfixOf "re-partitioned")-    it "classifies a process input type change as ProcessInputChanged" $ do-      cs <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-inputtype.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [ProcessInputChanged]-    it "classifies workflow input and output changes as WorkflowShapeChanged" $ do-      input <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-inputfield.keiro"-      [(.code) k | Breaking k <- input] `shouldContain` [WorkflowShapeChanged]-      output <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-output.keiro"-      [(.code) k | Breaking k <- output] `shouldContain` [WorkflowShapeChanged]-    it "classifies workflow relabeling and appends as WorkflowBodyChanged" $ do-      relabeled <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-body.keiro"-      [(.code) k | Breaking k <- relabeled] `shouldContain` [WorkflowBodyChanged]-      appended <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-stepadd.keiro"-      [(.code) k | Breaking k <- appended] `shouldContain` [WorkflowBodyChanged]-      [(.detail) k | Breaking k <- appended, (.code) k == WorkflowBodyChanged]-        `shouldSatisfy` any (T.isInfixOf "new patch guard")-    it "classifies a body addition wholly guarded by a new patch as additive" $ do-      cs <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-evolution-diff.keiro"-      any isBreaking cs `shouldBe` False-      [(.subject) k | Additive k <- cs, (.facet) k == "workflow-patch"] `shouldContain` ["fraud-check-v2"]-      [(.subject) k | Additive k <- cs, (.facet) k == "workflow-continue-as-new"] `shouldContain` ["RolloverSeed"]-    it "classifies removing an existing patch as breaking" $ do-      cs <- diffFixtures "test/fixtures/workflow-evolution-diff.keiro" "test/fixtures/workflow-continue.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [WorkflowPatchRemoved]-      [(.detail) k | Breaking k <- cs, (.code) k == WorkflowPatchRemoved]-        `shouldSatisfy` any (T.isInfixOf "cannot prove")-    it "classifies terminal continueAsNew append as additive and seed drift as breaking" $ do-      appended <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-continue.keiro"-      any isBreaking appended `shouldBe` False-      [(.facet) k | Additive k <- appended] `shouldContain` ["workflow-continue-as-new"]-      changed <- diffFixtures "test/fixtures/workflow-continue.keiro" "test/fixtures/workflow-continue-seed-v2.keiro"-      [(.code) k | Breaking k <- changed] `shouldContain` [WorkflowContinueSeedChanged]-      [(.detail) k | Breaking k <- changed, (.code) k == WorkflowContinueSeedChanged]-        `shouldSatisfy` any (T.isInfixOf "restoreSeed")-    it "classifies a workflow stable-name change as WorkflowStableNameChanged" $ do-      cs <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-rename.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [WorkflowStableNameChanged]-    it "classifies workflow id-derivation changes as DerivedIdentityChanged" $ do-      cs <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-idfield.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [DerivedIdentityChanged]-    it "classifies an id prefix change as IdPrefixChanged" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-idprefix.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [IdPrefixChanged]-    it "classifies intake dedupe key and policy changes as DedupeIdentityChanged" $ do-      policy <- diffFixtures "test/fixtures/intake.keiro" "test/fixtures/intake-dedupepolicy.keiro"-      [(.code) k | Breaking k <- policy] `shouldContain` [DedupeIdentityChanged]-      key <- diffFixtures "test/fixtures/intake.keiro" "test/fixtures/intake-dedupekey.keiro"-      [(.code) k | Breaking k <- key] `shouldContain` [DedupeIdentityChanged]-    it "reports intake decode-posture changes as warnings" $ do-      cs <- diffFixtures "test/fixtures/intake.keiro" "test/fixtures/intake-decode.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldContain` [DecodePostureChanged]-      [(.code) k | Advisory k <- cs] `shouldContain` [IntakePersistenceChanged]-    it "classifies process and timer derivation changes as DerivedIdentityChanged" $ do-      processName <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-procname.keiro"-      [(.code) k | Breaking k <- processName] `shouldContain` [DerivedIdentityChanged]-      timerId <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-timerid.keiro"-      [(.code) k | Breaking k <- timerId] `shouldContain` [DerivedIdentityChanged]-      base <- specOf "test/fixtures/hospital-surge.keiro"-      let categoryChange = diffSpecs base (modifyProcess "HospitalSurge" (\process -> processWithSaga (sagaRefWithCategory "hospitalSurgeV2" process.saga) process) base)-      [(.code) k | Breaking k <- categoryChange] `shouldContain` [DerivedIdentityChanged]-    it "classifies router stable names, keys, and targets as identity-bearing" $ do-      base <- specOf "test/fixtures/incident-paging/incident-paging.keiro"-      let stableName = diffSpecs base (modifyRouter "PagingRouter" (routerWithName "paging-v2") base)-          keyDerivation = diffSpecs base (modifyRouter "PagingRouter" (\router -> routerWithKey (correlateDeclWithVia "otherIdText" router.key) router) base)-          target = diffSpecs base (modifyRouter "PagingRouter" (routerWithTarget "OtherPage") base)-      [(.code) k | Breaking k <- stableName] `shouldContain` [RouterStableNameChanged]-      [(.code) k | Breaking k <- keyDerivation] `shouldContain` [DerivedIdentityChanged]-      [(.code) k | Breaking k <- target] `shouldContain` [DerivedIdentityChanged]-    it "advises on router dispatch-surface changes without making them breaking" $ do-      cs <- diffFixtures "test/fixtures/incident-paging/incident-paging.keiro" "test/fixtures/incident-paging/incident-paging-dispatch.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldBe` [RouterDecideSurfaceChanged]-    it "advises on process dispatch-surface changes without making them breaking" $ do-      cs <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-handle.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldBe` [ProcessDecideSurfaceChanged]-    it "advises on unversioned timer payload changes without making them breaking" $ do-      cs <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-payload.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldBe` [ProcessTimerPayloadChanged]-    it "ignores formatting-only process and timer surface rewrites" $ do-      original <- specOf "test/fixtures/hospital-surge.keiro"-      formatted <- shouldParseStableRenderedSpec "<formatted-process>" original-      diffSpecs original formatted `shouldBe` []-    it "reports a timer window change as a warning" $ do-      cs <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-window.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldContain` [TimerWindowChanged]-    it "reports emit-map changes as warnings and derive changes as breaking" $ do-      mapping <- diffFixtures "test/fixtures/emit.keiro" "test/fixtures/emit-mapchange.keiro"-      any isBreaking mapping `shouldBe` False-      [(.code) k | Advisory k <- mapping] `shouldContain` [EmitMappingChanged]-      derive <- diffFixtures "test/fixtures/emit.keiro" "test/fixtures/emit-derive.keiro"-      [(.code) k | Breaking k <- derive] `shouldContain` [DerivedIdentityChanged]-    it "classifies publisher outbox identity and ordering independently" $ do-      outbox <- diffFixtures "test/fixtures/emit.keiro" "test/fixtures/emit-outboxfield.keiro"-      [(.code) k | Breaking k <- outbox] `shouldContain` [DerivedIdentityChanged]-      ordering <- diffFixtures "test/fixtures/emit.keiro" "test/fixtures/emit-ordering.keiro"-      any isBreaking ordering `shouldBe` False-      [(.code) k | Advisory k <- ordering] `shouldContain` [PublisherPolicyChanged]-    it "classifies workqueue names as QueueIdentityChanged" $ do-      cs <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-rename.keiro"-      [(.code) k | Breaking k <- cs] `shouldContain` [QueueIdentityChanged]-    it "classifies pgmq dispatch dedupe and retargeting independently" $ do-      dedupe <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-dedupkey.keiro"-      [(.code) k | Breaking k <- dedupe] `shouldContain` [DedupeIdentityChanged]-      retarget <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-retarget.keiro"-      any isBreaking retarget `shouldBe` False-      [(.code) k | Advisory k <- retarget] `shouldContain` [DispatchRetargeted]-    it "reports aggregate projection changes as warnings" $ do-      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-projection.keiro"-      any isBreaking cs `shouldBe` False-      [(.code) k | Advisory k <- cs] `shouldContain` [ProjectionChanged]-    it "classifies read-model version and unversioned shape changes" $ do-      base <- specOf "test/fixtures/readmodel-runtime.keiro"-      let versionTwo = modifyReadModel "transfer_decisions" (readModelWithVersion 2) base-          changedShape = modifyReadModel "transfer_decisions" changeReadModelShape base-          bumpedShape = modifyReadModel "transfer_decisions" (readModelWithVersion 2 . changeReadModelShape) base-          decreased = diffSpecs versionTwo base-          unversioned = diffSpecs base changedShape-          bumped = diffSpecs base bumpedShape-      [(.code) k | Breaking k <- decreased] `shouldContain` [ReadModelVersionDecreased]-      [(.code) k | Breaking k <- unversioned] `shouldContain` [ReadModelShapeChangedWithoutBump]-      any isBreaking bumped `shouldBe` False-      [(.facet) k | Additive k <- bumped] `shouldContain` ["read-model-version"]-    it "classifies query input and result changes only on the consumer-build surface" $ do-      source <- mappedConsumerSurfaceSource-      base <- parseInlineSpec "<mapped-query-diff-old>" source-      let changeQuery update =-            modifyReadModel-              "ArtifactLookup"-              ( \readModel ->-                  readModelWithQueryTypes (fmap update readModel.queryTypes) readModel-              )-              base-          inputChanged = changeQuery (\queryPair -> readModelQueryTypesWithInput (TList queryPair.input) queryPair)-          resultChanged = changeQuery (readModelQueryTypesWithResult (TRef "ArtifactInfo"))-          assertBuildOnly expectedCode changes = case [kind | Advisory kind <- changes, (.code) kind == expectedCode] of-            [kind] -> do-              (.consumerBuild) (kind.vector) `shouldBe` VBreaking-              (.privateHistoryRead) (kind.vector) `shouldBe` VCompatible-              (.oldBinaryReadNewEvents) (kind.vector) `shouldBe` VCompatible-              (.snapshotHydration) (kind.vector) `shouldBe` VNotApplicable-              (.publicConsumer) (kind.vector) `shouldBe` VNotApplicable-              (.persistedIdentity) (kind.vector) `shouldBe` VNotApplicable-              (.mappedPersistedImpact) kind `shouldBe` Nothing-              remediationFor (kind.context) ((.code) kind)-                `shouldBe` RemedyRecompileConsumers :| [RemedyRunConformance]-            values -> expectationFailure ("expected one query build finding, got " <> show values)-          onlyReadModel spec = case [readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == "ArtifactLookup"] of-            [readModel] -> readModel-            values -> error ("expected one ArtifactLookup read model, got " <> show values)-      assertBuildOnly ReadModelQueryInputChanged (diffSpecs base inputChanged)-      assertBuildOnly ReadModelQueryResultChanged (diffSpecs base resultChanged)-      canonicalShape (onlyReadModel inputChanged) `shouldBe` canonicalShape (onlyReadModel base)-      deriveShapeHash (onlyReadModel resultChanged) `shouldBe` deriveShapeHash (onlyReadModel base)-      projectionCatalogFacts inputChanged `shouldBe` projectionCatalogFacts base-      registryNameFor (inputChanged.context) (onlyReadModel inputChanged)-        `shouldBe` registryNameFor (base.context) (onlyReadModel base)-      replayImpactSpecs base inputChanged `shouldBe` ReplayNeutral-    it "classifies read-model registry, table, subscription, and removal identities" $ do-      base <- specOf "test/fixtures/readmodel-runtime.keiro"-      let tableChanged = modifyReadModel "transfer_decisions" (readModelWithTable "transfer_decisions_v2") base-          subscriptionChanged = modifyReadModel "transfer_decisions" (\readModel -> readModelWithSupply (setLegacySubscription (Just "transfer-decisions-v2") readModel.supply) readModel) base-          renamed = modifyReadModel "transfer_decisions" (readModelWithName "reservation_decisions") base-          removed = removeReadModel "transfer_decisions" base-      mapM_-        (\changes -> [(.code) k | Breaking k <- changes] `shouldContain` [DerivedIdentityChanged])-        [diffSpecs base tableChanged, diffSpecs base subscriptionChanged, diffSpecs base renamed, diffSpecs base removed]-    it "classifies read-model feed flips and consistency/scope weakening as breaking" $ do-      base <- specOf "test/fixtures/readmodel-runtime.keiro"-      let feedChanged = modifyReadModel "transfer_decisions" (\readModel -> readModel {supply = setLegacyFeed RmInline ((.supply) readModel)}) base-          consistencyWeakened = modifyReadModel "transfer_decisions" (\readModel -> readModel {supply = setLegacyConsistency Eventual ((.supply) readModel), freshness = FreshnessImmediate}) base-          entireLog = modifyReadModel "transfer_decisions" (\readModel -> readModel {supply = setLegacyScope (Just RmEntireLog) ((.supply) readModel), freshness = FreshnessWaitForHead RmEntireLog}) base-      [(.code) k | Breaking k <- diffSpecs base feedChanged] `shouldContain` [ReadModelFeedChanged]-      [(.code) k | Breaking k <- diffSpecs base consistencyWeakened] `shouldContain` [ReadModelConsistencyWeakened]-      [(.code) k | Breaking k <- diffSpecs entireLog base] `shouldContain` [ReadModelConsistencyWeakened]-    it "classifies Eventual to Strong read-model consistency as additive" $ do-      strong <- specOf "test/fixtures/readmodel-runtime.keiro"-      let eventual = modifyReadModel "transfer_decisions" (\readModel -> readModel {supply = setLegacyConsistency Eventual ((.supply) readModel), freshness = FreshnessImmediate}) strong-          changes = diffSpecs eventual strong-      any isBreaking changes `shouldBe` False-      [(.facet) k | Additive k <- changes] `shouldContain` ["read-model-consistency"]-    it "classifies the legacy Strong to language-5 immediate freshness migration as breaking" $ do-      source <- readTestText "test/fixtures/readmodel-migration-l4.keiro"-      let legacyStrongPolicy =-            "  consistency = Strong\n  scope = category \"reservation\"\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"-          toLanguage5 policy =-            T.replace "language keiro-dsl 4" "language keiro-dsl 5"-              . T.replace legacyStrongPolicy policy-      legacyStrong <- checkedServiceFromText "readmodel-migration-legacy-strong.keiro" source-      immediate <- checkedServiceFromText "readmodel-migration-immediate.keiro" (toLanguage5 "  freshness = immediate\n" source)-      let changes = diffServices legacyStrong immediate-      [(.code) k | Breaking k <- changes] `shouldContain` [QueryFreshnessChanged]-      [(.facet) k | Breaking k <- changes] `shouldContain` ["query-freshness"]-      [(.facet) k | Additive k <- changes] `shouldNotContain` ["read-model-scope"]-      [(.detail) k | Breaking k <- changes, (.code) k == QueryFreshnessChanged]-        `shouldSatisfy` any (T.isInfixOf "wait-for-head category 'reservation' -> immediate")-    it "keeps equivalent and strengthened freshness migrations non-breaking" $ do-      source <- readTestText "test/fixtures/readmodel-migration-l4.keiro"-      let legacyStrongPolicy =-            "  consistency = Strong\n  scope = category \"reservation\"\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"-          legacyEventualPolicy =-            "  consistency = Eventual\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"-          toLanguage5 policy =-            T.replace "language keiro-dsl 4" "language keiro-dsl 5"-              . T.replace legacyStrongPolicy policy-          readModelFacets = filter (\facet -> facet == "query-freshness" || "read-model-" `T.isPrefixOf` facet) . map ((.facet) . kindOfChange)-          assertEquivalent changes = do-            any isBreaking changes `shouldBe` False-            readModelFacets changes `shouldBe` []-      legacyStrong <- checkedServiceFromText "readmodel-migration-equivalent-legacy-strong.keiro" source-      strongEquivalent <- checkedServiceFromText "readmodel-migration-equivalent-wait.keiro" (toLanguage5 "  freshness = wait-for-head category \"reservation\"\n" source)-      assertEquivalent (diffServices legacyStrong strongEquivalent)-      let eventualSource = T.replace legacyStrongPolicy legacyEventualPolicy source-      legacyEventual <- checkedServiceFromText "readmodel-migration-equivalent-legacy-eventual.keiro" eventualSource-      immediate <- checkedServiceFromText "readmodel-migration-equivalent-immediate.keiro" (toLanguage5 "  freshness = immediate\n" source)-      assertEquivalent (diffServices legacyEventual immediate)-      strengthened <- checkedServiceFromText "readmodel-migration-strengthened.keiro" (toLanguage5 "  freshness = wait-for-head entire-log\n" source)-      let strengthenedChanges = diffServices legacyEventual strengthened-      any isBreaking strengthenedChanges `shouldBe` False-      [(.code) k | Additive k <- strengthenedChanges] `shouldContain` [CompatibilityStrengthened]-      [(.facet) k | Additive k <- strengthenedChanges] `shouldContain` ["query-freshness"]-    it "classifies scope changes and reverse downgrades in the freshness migration by the normalized pair" $ do-      source <- readTestText "test/fixtures/readmodel-migration-l4.keiro"-      let legacyStrongPolicy =-            "  consistency = Strong\n  scope = category \"reservation\"\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"-          legacyEventualPolicy =-            "  consistency = Eventual\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"-          toLanguage5 policy =-            T.replace "language keiro-dsl 4" "language keiro-dsl 5"-              . T.replace legacyStrongPolicy policy-      legacyStrong <- checkedServiceFromText "readmodel-migration-scope-legacy-strong.keiro" source-      widened <- checkedServiceFromText "readmodel-migration-scope-widened.keiro" (toLanguage5 "  freshness = wait-for-head entire-log\n" source)-      let widenedChanges = diffServices legacyStrong widened-      any isBreaking widenedChanges `shouldBe` False-      [(.code) k | Additive k <- widenedChanges] `shouldContain` [CompatibilityStrengthened]-      [(.facet) k | Additive k <- widenedChanges] `shouldContain` ["query-freshness"]-      categoryChanged <- checkedServiceFromText "readmodel-migration-scope-category-changed.keiro" (toLanguage5 "  freshness = wait-for-head category \"other\"\n" source)-      [(.code) k | Breaking k <- diffServices legacyStrong categoryChanged] `shouldContain` [QueryFreshnessChanged]-      immediate <- checkedServiceFromText "readmodel-migration-reverse-immediate.keiro" (toLanguage5 "  freshness = immediate\n" source)-      let reverseStrengthened = diffServices immediate legacyStrong-      any isBreaking reverseStrengthened `shouldBe` False-      [(.code) k | Additive k <- reverseStrengthened] `shouldContain` [CompatibilityStrengthened]-      legacyEventual <- checkedServiceFromText "readmodel-migration-reverse-legacy-eventual.keiro" (T.replace legacyStrongPolicy legacyEventualPolicy source)-      waitCategory <- checkedServiceFromText "readmodel-migration-reverse-wait.keiro" (toLanguage5 "  freshness = wait-for-head category \"reservation\"\n" source)-      [(.code) k | Breaking k <- diffServices waitCategory legacyEventual] `shouldContain` [QueryFreshnessChanged]-    it "keeps identical same-language freshness migration pairs free of policy findings" $ do-      source <- readTestText "test/fixtures/readmodel-migration-l4.keiro"-      let legacyStrongPolicy =-            "  consistency = Strong\n  scope = category \"reservation\"\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"-          language5Source =-            T.replace "language keiro-dsl 4" "language keiro-dsl 5"-              . T.replace legacyStrongPolicy "  freshness = immediate\n"-              $ source-          policyFacets = filter (\facet -> facet == "query-freshness" || "read-model-" `T.isPrefixOf` facet) . map ((.facet) . kindOfChange)-      language4 <- checkedServiceFromText "readmodel-migration-identical-language-4.keiro" source-      language5 <- checkedServiceFromText "readmodel-migration-identical-language-5.keiro" language5Source-      policyFacets (diffServices language4 language4) `shouldBe` []-      policyFacets (diffServices language5 language5) `shouldBe` []--  describe "module placement (M1)" $ do-    it "GeneratedPrefix is today's namespace (Generated.<Ctx>.<Node>, holes at <Ctx>.<Node>)" $ do-      let ctx = defaultContext "hospital-capacity"-      genPrefixFor ctx "Reservation" `shouldBe` "Generated.HospitalCapacity.Reservation"-      holePrefixFor ctx "Reservation" `shouldBe` "HospitalCapacity.Reservation"-    it "module-root prefixes both layers" $ do-      let ctx = contextWithModuleRoot "Acme" (defaultContext "hospital-capacity")-      genPrefixFor ctx "Reservation" `shouldBe` "Acme.Generated.HospitalCapacity.Reservation"-      holePrefixFor ctx "Reservation" `shouldBe` "Acme.HospitalCapacity.Reservation"-    it "CollocatedLeaf places the generated layer under the domain leaf" $ do-      let ctx = (defaultContext "hospital-capacity") {moduleRoot = "Acme", placement = CollocatedLeaf}-      genPrefixFor ctx "Reservation" `shouldBe` "Acme.HospitalCapacity.Reservation.Generated"-      holePrefixFor ctx "Reservation" `shouldBe` "Acme.HospitalCapacity.Reservation"-    it "parses and preserves the module/layout clauses through parse . pretty" $ do-      let src = "context hospital-capacity\nmodule Acme.Services\nlayout collocated\n\naggregate Reservation\n  regs\n  states Open\n"-      case parseSpec "<m1>" src of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> do-          (.moduleRoot) spec `shouldBe` Just "Acme.Services"-          (.layout) spec `shouldBe` Just CollocatedLeaf-          parseSpec "<m1>" (renderSpec spec) `shouldBe` Right spec-    it "a spec without the clauses leaves placement at the default" $ do-      input <- readTestText "test/fixtures/reservation.keiro"-      case parseSpec "test/fixtures/reservation.keiro" input of-        Left err -> expectationFailure (T.unpack err)-        Right spec -> do-          (.moduleRoot) spec `shouldBe` Nothing-          (.layout) spec `shouldBe` Nothing--  describe "structural scaffold" $ do-    it "emits one private shape module per structural declaration and one context facade" $ do-      spec <- specOf "test/fixtures/consumer-types.keiro"-      let modules = scaffoldModules (defaultContext (spec.context)) spec-          paths = map (.path) modules-      paths-        `shouldContain` [ "Generated/ConsumerDemo/Structural/Shape/ArtifactInfo.hs",-                          "Generated/ConsumerDemo/Structural/Shape/ArtifactKind.hs",-                          "Generated/ConsumerDemo/Structural/Shape/ArtifactLocation.hs",-                          "Generated/ConsumerDemo/StructuralProjections.hs"-                        ]-      paths `shouldNotContain` ["Generated/ConsumerDemo/Structural/Shape/VendorGeometry.hs"]-      firewallBreaches modules `shouldBe` []-    it "emits one create-once binding skeleton per owning module and derives Generic for private shapes" $ do-      spec <- specOf "test/fixtures/consumer-types.keiro"-      let modules = scaffoldModules (defaultContext (spec.context)) spec-          skeletons = [moduleValue | moduleValue <- modules, (.kind) moduleValue == HoleStub, (.path) moduleValue == "Example/Artifact/KeiroBindings.hs"]-          shape = generatedTextEndingIn "Structural/Shape/ArtifactInfo.hs" modules-      case skeletons of-        [skeleton] -> do-          (.text) skeleton `shouldSatisfy` T.isInfixOf "artifactInfoBinding :: StructuralBinding"-          (.text) skeleton `shouldSatisfy` T.isInfixOf "artifactKindBinding :: StructuralBinding"-          (.text) skeleton `shouldSatisfy` T.isInfixOf "artifactLocationBinding :: StructuralBinding"-          (.text) skeleton `shouldSatisfy` T.isInfixOf "HOLE: fill ArtifactInfo bindingToShape.key"-        _ -> expectationFailure ("expected exactly one shared binding skeleton, got " <> show (map (.path) skeletons))-      shape `shouldSatisfy` T.isInfixOf "deriving stock (Eq, Generic, Show)"-      shape `shouldSatisfy` T.isInfixOf "import GHC.Generics (Generic)"-    it "never overwrites an existing binding skeleton" $-      withTempDirectory "keiro-dsl-binding-create-once" $ \out -> do-        spec <- specOf "test/fixtures/consumer-types.keiro"-        let ctx = defaultContext (spec.context)-            bindingPath = out </> "Example/Artifact/KeiroBindings.hs"-        _ <- executePlannedScaffold out "consumer-types.keiro" ctx spec-        TIO.writeFile bindingPath "hand-owned binding\n"-        second <- executePlannedScaffold out "consumer-types.keiro" ctx spec-        TIO.readFile bindingPath `shouldReturn` "hand-owned binding\n"-        (.dispositions) second-          `shouldSatisfy` any (\(moduleValue, disposition) -> (.path) moduleValue == "Example/Artifact/KeiroBindings.hs" && disposition == Skipped)-    it "fresh binding skeletons compile at the application boundary" $-      withTempDirectory "keiro-dsl-binding-compiles" $ \out -> do-        spec <- specOf "test/fixtures/structural-conformance.keiro"-        let ctx = defaultContext (spec.context)-            ghcOutput = out </> ".ghc"-            domainSource = out </> "Conformance/Structural/Domain.hs"-        _ <- executePlannedScaffold out "structural-conformance.keiro" ctx spec-        readTestText "test/conformance-structural/Conformance/Structural/Domain.hs"-          >>= writeFileWithParents domainSource-        createDirectoryIfMissing True ghcOutput-        keiroCorePackageId <- activeCabalPackageId "keiro-core"-        (exitCode, standardOutput, standardError) <--          readProcessWithExitCode-            "cabal"-            [ "exec",-              "--enable-tests",-              "--",-              "ghc",-              "-XGHC2024",-              "-XOverloadedStrings",-              "-fno-code",-              "-fforce-recomp",-              "-package-id",-              keiroCorePackageId,-              "-outputdir",-              ghcOutput,-              "-i" <> out,-              "-itest/conformance-structural",-              out </> "Conformance/Structural/Bindings.hs"-            ]-            ""-        unless (exitCode == ExitSuccess) $-          expectationFailure (standardOutput <> standardError)-    it "keeps consumer types in Domain while the generated Codec owns keys, tags, and defaults" $ do-      spec <- specOf "test/fixtures/consumer-types.keiro"-      let modules = scaffoldModules (defaultContext (spec.context)) spec-          domain = generatedTextEndingIn "Catalog/Domain.hs" modules-          codec = generatedTextEndingIn "Catalog/Codec.hs" modules-      domain `shouldSatisfy` T.isInfixOf "import Example.Artifact.Domain (ArtifactInfo)"-      domain `shouldSatisfy` T.isInfixOf "import Vendor.Geometry (Geometry)"-      domain `shouldSatisfy` T.isInfixOf "artifact :: !ArtifactInfo"-      domain `shouldSatisfy` T.isInfixOf "RCons (Proxy @\"currentArtifact\") ArtifactKeiroBindings.emptyArtifactInfo"-      domain `shouldSatisfy` (not . T.isInfixOf "Example.Artifact.Domain.ArtifactInfo")-      codec `shouldSatisfy` T.isInfixOf "\"location\" .= encodeArtifactLocationShape"-      codec `shouldSatisfy` T.isInfixOf "\"local_file\""-      codec `shouldSatisfy` T.isInfixOf "parseOptionalField (pure ShapeArtifactKind.Guide)"-      codec `shouldSatisfy` T.isInfixOf "rejectUnknownFields \"ArtifactInfo\""-      codec `shouldSatisfy` T.isInfixOf "toJSON payload.geometry"-      codec `shouldSatisfy` (not . T.isInfixOf "vendor.geometry.json")-    it "generates shape-only nested types and schema-derived Keiki witnesses" $ do-      spec <- specOf "test/fixtures/consumer-types.keiro"-      let modules = scaffoldModules (defaultContext (spec.context)) spec-          shape = generatedTextEndingIn "Structural/Shape/ArtifactInfo.hs" modules-          facade = generatedTextEndingIn "StructuralProjections.hs" modules-      shape `shouldSatisfy` T.isInfixOf "data ArtifactInfoShape = ArtifactInfo"-      shape `shouldSatisfy` T.isInfixOf "ArtifactKind.ArtifactKindShape"-      mapM_-        (shape `shouldSatisfy`)-        [ T.isInfixOf "description :: !(Maybe Text)",-          T.isInfixOf "tags :: ![Text]",-          T.isInfixOf "labels :: ![Maybe Text]",-          T.isInfixOf "attributes :: !(Map Text Text)"-        ]-      mapM_-        (shape `shouldNotSatisfy`)-        [ T.isInfixOf "description :: !(Maybe (Text))",-          T.isInfixOf "tags :: !([Text])",-          T.isInfixOf "labels :: !([(Maybe (Text))])",-          T.isInfixOf "attributes :: !(Map Text (Text))"-        ]-      shape `shouldSatisfy` (not . T.isInfixOf "KeiroBindings")-      facade `shouldSatisfy` T.isInfixOf "type FieldName"-      facade `shouldSatisfy` T.isInfixOf "= \"/key\""-      facade `shouldSatisfy` T.isInfixOf "fieldShapeId _ = \"example.artifact.ArtifactInfo.v1\""-      facade `shouldSatisfy` T.isInfixOf "type FieldOwner ArtifactInfoKeyProjection = ArtifactInfo"-      facade `shouldSatisfy` T.isInfixOf "bindingToShape KeiroBindings.artifactInfoBinding owner"-      facade `shouldSatisfy` (not . T.isInfixOf "Example.Artifact.Domain.ArtifactInfo")-      facade `shouldSatisfy` T.isInfixOf "artifactInfoKeyWitness"-      facade `shouldNotSatisfy` T.isInfixOf "structuralProjectionC"-    it "suffixes only structural witness names that collide after normalization" $ do-      source <- readTestText "test/fixtures/consumer-types.keiro"-      collisionSpec <--        parseInlineSpec-          "<projection-name-collision>"-          ( T.replace-              "    key         as \"key\"         : Text                 required"-              ( T.unlines-                  [ "    key         as \"key\"         : Text                 required",-                    "    fooDash     as \"foo-bar\"     : Text                 required",-                    "    fooUnder    as \"foo_bar\"     : Text                 required"-                  ]-              )-              source-          )-      graph <- shouldResolveTypeGraph collisionSpec-      let specs = projectionSpecs graph-          keyWitnesses = [spec.witness | spec <- specs, (.pointer) spec == "/key"]-          collidedWitnesses = [spec.witness | spec <- specs, (.pointer) spec `elem` ["/foo-bar", "/foo_bar"]]-      keyWitnesses `shouldBe` ["artifactInfoKeyWitness"]-      length collidedWitnesses `shouldBe` 2-      Set.size (Set.fromList collidedWitnesses) `shouldBe` 2-      collidedWitnesses `shouldSatisfy` all (T.isPrefixOf "artifactInfoFooBar")-      collidedWitnesses `shouldSatisfy` all (T.isSuffixOf "Witness")-      collidedWitnesses `shouldSatisfy` all ((== 8) . T.length . T.dropEnd (T.length ("Witness" :: T.Text)) . T.drop (T.length ("artifactInfoFooBar" :: T.Text)))-    it "uses only precedence-required parentheses in nested record field types" $ do-      let spec =-            mappedSpec-              [ completeStructural-                  "Nested"-                  ( recordShape-                      [ TMap (TOptional TText),-                        TOptional (TList TText),-                        TOptional (TMap TText)-                      ]-                  )-              ]-          shape = generatedTextEndingIn "Structural/Shape/Nested.hs" (scaffoldStructural (defaultContext (spec.context)) spec)-      mapM_-        (shape `shouldSatisfy`)-        [ T.isInfixOf "field1 :: !(Map Text (Maybe Text))",-          T.isInfixOf "field2 :: !(Maybe [Text])",-          T.isInfixOf "field3 :: !(Maybe (Map Text Text))"-        ]-    it "uses the same precedence rules for strict union payloads" $ do-      let spec =-            mappedSpec-              [ completeStructural-                  "Payload"-                  ( ShapeUnion-                      (TaggedObject "tag" "contents" RejectUnknown)-                      [ WireArm "OptionalPayload" "optional" (Just (TOptional TText)) noLoc,-                        WireArm "ListPayload" "list" (Just (TList (TOptional TText))) noLoc,-                        WireArm "MapPayload" "map" (Just (TMap (TOptional TText))) noLoc-                      ]-                  )-              ]-          shape = generatedTextEndingIn "Structural/Shape/Payload.hs" (scaffoldStructural (defaultContext (spec.context)) spec)-      mapM_-        (shape `shouldSatisfy`)-        [ T.isInfixOf "OptionalPayload !(Maybe Text)",-          T.isInfixOf "ListPayload ![Maybe Text]",-          T.isInfixOf "MapPayload !(Map Text (Maybe Text))"-        ]--  describe "structural manifest" $ do-    it "lists consumer packages and every domain, binding, fixture, and initial module" $ do-      spec <- specOf "test/fixtures/consumer-types.keiro"-      let modules = scaffoldModules (defaultContext (spec.context)) spec-          manifest = renderManifest "consumer-types.keiro" modules spec-      assertGeneratedHaskellContract "consumer-types.keiro" manifest-      mapM_ (\packageName -> manifestDependencies spec `shouldContain` [packageName]) ["artifact-domain", "vendor-geometry"]-      manifest `shouldSatisfy` T.isInfixOf "consumer-packages:\n    artifact-domain\n    vendor-geometry"-      mapM_-        (\moduleName -> manifest `shouldSatisfy` T.isInfixOf moduleName)-        [ "Example.Artifact.Domain",-          "Example.Artifact.KeiroBindings",-          "Vendor.Geometry",-          "Vendor.Geometry.KeiroBindings"-        ]--  describe "structural scaffold record" $ do-    it "round-trips canonical mapping rows and reports binding drift on the next run" $-      withTempDirectory "keiro-dsl-mapping-record" $ \out -> do-        spec <- specOf "test/fixtures/consumer-types.keiro"-        let ctx = defaultContext (spec.context)-        first <- executePlannedScaffold out "consumer-types.keiro" ctx spec-        length first.consumerPlan.mappings `shouldBe` 4-        recordText <- TIO.readFile (out </> recordFileName (spec.context))-        let mappingRows = filter (T.isPrefixOf "mapping ") (T.lines recordText)-            bindingRows = filter (T.isPrefixOf "binding ") (T.lines recordText)-        length mappingRows `shouldBe` 4-        bindingRows `shouldSatisfy` (not . null)-        fmap (.mappings) (parseRecord recordText) `shouldSatisfy` maybe False ((== 4) . length)-        fmap (.bindingObligations) (parseRecord recordText) `shouldSatisfy` maybe False ((== length bindingRows) . length)-        let bumped = spec {mapped = map bumpArtifactBindingVersion ((.mapped) spec)}-        second <- executePlannedScaffold out "consumer-types.keiro" ctx bumped-        (.mappingDrift) second-          `shouldSatisfy` any (\drift -> (.specName) drift == "ArtifactInfo" && (.previous) drift /= (.current) drift)-        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "mapping drift:")-        case mappingRows of-          row : _ -> parseRecord (recordText <> row <> "\n") `shouldBe` Nothing-          [] -> expectationFailure "expected mapping rows"-        case bindingRows of-          row : _ -> parseRecord (recordText <> row <> "\n") `shouldBe` Nothing-          [] -> expectationFailure "expected binding rows"-    it "reports exactly the newly added binding field without rewriting the shared skeleton" $-      withTempDirectory "keiro-dsl-binding-drift" $ \out -> do-        spec <- specOf "test/fixtures/consumer-types.keiro"-        let ctx = defaultContext (spec.context)-        _ <- executePlannedScaffold out "consumer-types.keiro" ctx spec-        let extended = spec {mapped = map addArtifactSummaryField ((.mapped) spec)}-        second <- executePlannedScaffold out "consumer-types.keiro" ctx extended-        (.newHoles) second-          `shouldBe` [ BindingHole-                         { mappedName = "ArtifactInfo",-                           moduleName = "Example.Artifact.KeiroBindings",-                           symbol = "artifactInfoBinding",-                           kind = BindingValue,-                           path = Just "summary",-                           signature = "artifactInfoBinding.summary :: Text"-                         }-                     ]-        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "artifactInfoBinding.summary :: Text")-    it "rejects malformed known mapping JSON while ignoring unrelated future rows" $ do-      spec <- specOf "test/fixtures/consumer-types.keiro"-      withTempDirectory "keiro-dsl-mapping-malformed" $ \out -> do-        report <- executePlannedScaffold out "consumer-types.keiro" (defaultContext (spec.context)) spec-        recordText <- TIO.readFile ((.recordPath) report)-        parseRecord (recordText <> "mapping {not-json}\n") `shouldBe` Nothing-        parseRecord (recordText <> "future-row retained\n") `shouldBe` parseRecord recordText-    it "reports current and legacy semantic impact without globalizing aggregate artifacts" $-      withTempDirectory "keiro-dsl-semantic-impact-report" $ \root -> do-        old <- specOf "test/fixtures/structural-locality.keiro"-        let new = addAlphaPayloadOptionalField old-            legacyNew = mapMappedStructural "AlphaPayload" changeMappedCanonical old-            ctx = defaultContext (old.context)-            currentOut = root </> "current"-            legacyOut = root </> "legacy"-            assertAlphaOnly report = do-              map (.declaration) ((.deltas) (report.semanticImpact))-                `shouldBe` [MappedKey "AlphaPayload"]-              map (.previousConsumers) ((.deltas) (report.semanticImpact))-                `shouldBe` [Set.singleton (AggregateConsumer "Alpha")]-              map (.currentConsumers) ((.deltas) (report.semanticImpact))-                `shouldBe` [Set.singleton (AggregateConsumer "Alpha")]-              let semanticLines = renderSemanticImpactReport (report.semanticImpact)-              semanticLines `shouldSatisfy` any (T.isInfixOf "current aggregate consumers:  Alpha")-              semanticLines `shouldSatisfy` all (not . T.isInfixOf "Beta")-              map (.category) ((.generatedArtifactImpact) report)-                `shouldContain` [ServiceStructuralConformanceArtifact]-              map (.path) ((.generatedArtifactImpact) report)-                `shouldSatisfy` all (not . T.isInfixOf "/Beta/" . T.pack)-        _ <- executePlannedScaffold currentOut "semantic-impact.keiro" ctx old-        current <- executePlannedScaffold currentOut "semantic-impact.keiro" ctx new-        assertAlphaOnly current--        firstLegacy <- executePlannedScaffold legacyOut "semantic-impact.keiro" ctx old-        legacyText <- TIO.readFile ((.recordPath) firstLegacy)-        TIO.writeFile-          ((.recordPath) firstLegacy)-          (T.unlines (filter (not . T.isPrefixOf "semantic-impact ") (T.lines legacyText)))-        legacy <- executePlannedScaffold legacyOut "semantic-impact.keiro" ctx legacyNew-        let legacyLines = renderSemanticImpactReport (legacy.semanticImpact)-        legacyLines `shouldSatisfy` any (T.isInfixOf "baseline: unavailable (legacy ledger)")-        legacyLines `shouldSatisfy` any (T.isInfixOf "current aggregate consumers: Alpha")-        legacyLines `shouldSatisfy` all (not . T.isInfixOf "Beta")-        currentLedger <- TIO.readFile ((.recordPath) legacy)-        (parseRecord currentLedger >>= (.semanticImpact)) `shouldSatisfy` maybe False (const True)-        third <- executePlannedScaffold legacyOut "semantic-impact.keiro" ctx legacyNew-        (.declarations) (third.semanticImpact) `shouldBe` []--  describe "structural import plan" $ do-    it "reports the successful dependency plan in the scaffold report" $-      withTempDirectory "keiro-dsl-dependency-plan" $ \out -> do-        spec <- specOf "test/fixtures/consumer-types.keiro"-        report <- executePlannedScaffold out "consumer-types.keiro" (defaultContext (spec.context)) spec-        renderScaffoldReport report-          `shouldSatisfy` any (T.isInfixOf "dependency plan: consumer packages [artifact-domain, vendor-geometry]")-    it "refuses a binding module inside the generated namespace with the exact cycle" $ do-      spec <- specOf "test/fixtures/consumer-types.keiro"-      let cyclic = spec {mapped = map moveArtifactBindingIntoGenerated ((.mapped) spec)}-      case planTestScaffold (defaultContext (cyclic.context)) cyclic of-        Left refusals -> do-          refusals `shouldSatisfy` any isImportCycle-          renderRefusals refusals `shouldSatisfy` any (T.isInfixOf "Generated.ConsumerDemo.Bindings")-        Right _ -> expectationFailure "expected an import-cycle refusal"-    it "refuses missing mapped register initials but permits command/event-only use" $ do-      missing <- specOf "test/fixtures/mapped-missing-initial.keiro"-      planTestScaffold (defaultContext (missing.context)) missing `shouldSatisfy` isFoldSurfaceRefusal-      spec <- specOf "test/fixtures/consumer-types.keiro"-      let commandOnly = removeMappedRegisterRequirements spec-      planTestScaffold (defaultContext (commandOnly.context)) commandOnly `shouldSatisfy` isRight--  describe "binding explanations" $ do-    it "lists binding, fixture, and use-site-scoped initial obligations deterministically" $ do-      spec <- specOf "test/fixtures/consumer-types.keiro"-      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligations spec)-      length obligations `shouldBe` 7-      obligations-        `shouldSatisfy` any-          ( \obligation ->-              (.kind) obligation == BindingValue-                && (.symbol) obligation == "artifactInfoBinding"-                && (.bindingVersion) obligation == Just "1"-          )-      obligations-        `shouldSatisfy` any-          ( \obligation ->-              (.kind) obligation == InitialValue-                && (.symbol) obligation == "emptyArtifactInfo"-                && any (T.isInfixOf "Catalog register currentArtifact") ((.useSites) obligation)-          )-      let rendered = renderBindingObligations (spec.context) obligations-      rendered `shouldSatisfy` T.isInfixOf "binding obligations for context consumer-demo"-      rendered `shouldSatisfy` T.isInfixOf "artifactInfoBinding :: StructuralBinding Example.Artifact.Domain.ArtifactInfo ArtifactInfoShape"-      rendered `shouldSatisfy` T.isInfixOf "provenance: binding-version \"1\""-    it "states explicitly when a spec has no structural obligations" $ do-      spec <- specOf "test/fixtures/reservation.keiro"-      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligations spec)-      renderBindingObligations (spec.context) obligations-        `shouldBe` "no binding obligations for context hospital-capacity"--  describe "exact generic structural bindings" $ do-    forM_-      [ ("renamed-field", "selector mismatch"),-        ("reordered-field", "selector mismatch"),-        ("arity-mismatch", "no exact nominal correspondence"),-        ("incompatible-type", "no exact nominal correspondence")-      ]-      $ \(fixture, diagnostic) ->-        it ("rejects " <> fixture <> " and directs the author to the scaffolded module") $-          expectGenericCompileFailure fixture diagnostic--  describe "structural conformance ownership" $ do-    it "emits declaration laws once at context scope and keeps aggregate-use evidence local" $ do-      service <- checkedServiceOf "test/fixtures/consumer-types.keiro"-      let spec = checkedSpec service-          ctx = defaultContext (spec.context)-          modules = scaffoldServiceModules ctx service-          structural = generatedTextEndingIn "StructuralConformance.hs" modules-          harness = generatedTextEndingIn "Harness.hs" modules-      mapM_-        (\needle -> structural `shouldSatisfy` T.isInfixOf needle)-        [ "binding domain round-trip: example.artifact.ArtifactInfo.v1/",-          "binding shape round-trip: example.artifact.ArtifactInfo.v1/",-          "fixture coverage: example.artifact.ArtifactLocation.v1",-          "canonical identity: example.artifact.ArtifactInfo.v1",-          "projection witness agreement: example.artifact.ArtifactInfo.v1/key",-          "opaque codec round-trip: vendor.geometry.json@3/"-        ]-      mapM_-        (\needle -> harness `shouldSatisfy` T.isInfixOf needle)-        [ "mapped codec round-trip: ArtifactObserved/artifact/",-          "wire policy missing default: example.artifact.ArtifactInfo.v1/description",-          "wire policy explicit null: example.artifact.ArtifactInfo.v1/description",-          "wire policy unknown fields: example.artifact.ArtifactInfo.v1",-          "wire union arm: example.artifact.ArtifactLocation.v1/local_file",-          "forward/replay equality: ObserveArtifact from CatalogEmpty -- ",-          "register currentArtifact"-        ]-      harness `shouldNotSatisfy` T.isInfixOf "binding domain round-trip:"-      harness `shouldNotSatisfy` T.isInfixOf "fixture coverage:"-      harness `shouldNotSatisfy` T.isInfixOf "projection witness agreement:"-      structural `shouldNotSatisfy` T.isInfixOf "mapped codec round-trip:"-      structural `shouldNotSatisfy` T.isInfixOf "wire policy missing default:"-    it "keeps opaque declaration checks at service scope without inventing structural wire policy" $ do-      service <- checkedServiceOf "test/fixtures/consumer-types.keiro"-      let spec = checkedSpec service-          modules = scaffoldServiceModules (defaultContext (spec.context)) service-          structural = generatedTextEndingIn "StructuralConformance.hs" modules-          harness = generatedTextEndingIn "Harness.hs" modules-          codec = generatedTextEndingIn "Codec.hs" modules-      structural `shouldSatisfy` T.isInfixOf "opaque codec round-trip: vendor.geometry.json@3/"-      harness `shouldNotSatisfy` T.isInfixOf "opaque codec round-trip: vendor.geometry.json@3/"-      structural `shouldNotSatisfy` T.isInfixOf "wire policy unknown fields: vendor.geometry.json"-      structural `shouldNotSatisfy` T.isInfixOf "fixture coverage: vendor.geometry"-      codec `shouldNotSatisfy` T.isInfixOf "encodeVendorGeometryShape"-    it "keeps an opaque-only context self-contained" $ do-      service <- checkedServiceOf "test/fixtures/consumer-types.keiro"-      let spec = checkedSpec service-          opaqueOnly =-            checkedServiceWithSpec-              ( spec-                  { mapped = [declaration | declaration@MappedOpaque {} <- (.mapped) spec],-                    nodes = []-                  }-              )-              service-          structural = generatedTextEndingIn "StructuralConformance.hs" (scaffoldServiceModules (defaultContext (spec.context)) opaqueOnly)-      structural `shouldSatisfy` T.isInfixOf "import Keiro.Codec.Structural (FixtureCases (..))"-      structural `shouldSatisfy` T.isInfixOf "opaque codec round-trip: vendor.geometry.json@3/"-      structural `shouldNotSatisfy` T.isInfixOf "bindingDomainRoundTrip"-    it "imports the context structural gate once through the service facade" $ do-      service <- checkedServiceOf "test/fixtures/consumer-types.keiro"-      let ctx = defaultContext ((checkedSpec service).context)-      case serviceHarnessModule ctx service of-        Left duplicates -> expectationFailure ("unexpected duplicate fact keys: " <> show duplicates)-        Right facade -> do-          T.count "import Generated.ConsumerDemo.StructuralConformance qualified as StructuralConformance" ((.text) facade) `shouldBe` 1-          T.count "StructuralConformance.structuralConformanceAssertions" ((.text) facade) `shouldBe` 1-          (.text) facade `shouldSatisfy` T.isInfixOf "\"structural/\" <> fact"-          (.text) facade `shouldNotSatisfy` T.isInfixOf "structuralConformanceAssertions] |"-    it "keeps every Beta artifact byte-identical when an Alpha-only mapped declaration changes" $ do-      workspace <- shouldComposeWorkspace "test/fixtures/structural-locality.keiro-workspace"-      let changedSpec = addAlphaPayloadOptionalField ((.mergedSpec) workspace)-          changedMember member = workspaceMemberWithSpec (addAlphaPayloadOptionalField member.spec) member-          changedWorkspace = workspaceWithMembersAndMergedSpec (map changedMember workspace.members) changedSpec workspace-          ctx = workspaceContext workspace-          plan value = planWorkspaceScaffold "goldens" ctx value-          moduleBytes owner planValue =-            Map.fromList-              [ ((.path) moduleValue, ((.text) moduleValue, (.kind) moduleValue, provenance))-              | (moduleValue, provenance) <- (.modules) planValue,-                ("/" <> owner <> "/") `T.isInfixOf` T.pack ((.path) moduleValue)-              ]-          moduleWith suffix planValue = generatedTextEndingIn suffix (map fst ((.modules) planValue))-      baseline <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (plan workspace)-      changed <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (plan changedWorkspace)-      moduleBytes "Beta" changed `shouldBe` moduleBytes "Beta" baseline-      moduleWith "Alpha/Harness.hs" changed `shouldNotBe` moduleWith "Alpha/Harness.hs" baseline-      moduleWith "StructuralConformance.hs" changed `shouldNotBe` moduleWith "StructuralConformance.hs" baseline-      let alphaHarness = moduleWith "Alpha/Harness.hs" changed-          betaHarness = moduleWith "Beta/Harness.hs" changed-          structural = moduleWith "StructuralConformance.hs" changed-      alphaHarness `shouldSatisfy` T.isInfixOf "mapped codec round-trip: AlphaSubmitted/item/"-      betaHarness `shouldNotSatisfy` T.isInfixOf "AlphaPayload"-      T.count "binding domain round-trip: example.locality.AlphaPayload.v1/" structural `shouldBe` 1-      alphaHarness `shouldNotSatisfy` T.isInfixOf "binding domain round-trip: example.locality.AlphaPayload.v1/"-      betaHarness `shouldNotSatisfy` T.isInfixOf "binding domain round-trip: example.locality.AlphaPayload.v1/"-      structural `shouldSatisfy` T.isInfixOf "fixture coverage: example.locality.UnusedPayload.v1"-    it "refuses a missing fixture before the CLI writes any scaffold output" $-      withTempDirectory "keiro-dsl-structural-no-write" $ \out -> do-        baselineTree <- treeSnapshot out-        (exitCode, _, standardError) <- runKeiroDsl ["scaffold", "test/fixtures/mapped-missing-fixture.keiro", "--out", out]-        exitCode `shouldSatisfy` (/= ExitSuccess)-        standardError `shouldContain` "missing fixtures ingredient"-        treeSnapshot out `shouldReturn` baselineTree--  describe "semantic locality qualification" $ do-    it "pins the exact A-only generated delta and semantic report" $-      withSemanticLocalityFixture "keiro-dsl-locality-a-only" id 0 $ \_ out workspace -> do-        baselinePlan <- shouldPlanWorkspaceSpec workspace-        let changedWorkspace = mapWorkspaceSpec addAlphaPayloadOptionalField workspace-        changedPlan <- shouldPlanWorkspaceSpec changedWorkspace-        let baselineModules = map fst ((.modules) baselinePlan)-            changedModules = map fst ((.modules) changedPlan)-            delta = generatedTreeDelta baselineModules changedModules-            expectedPaths =-              Set.fromList-                [ "Generated/SemanticLocality/Alpha/Codec.hs",-                  "Generated/SemanticLocality/Alpha/Harness.hs",-                  "Generated/SemanticLocality/Structural/Shape/AlphaPayload.hs",-                  "Generated/SemanticLocality/StructuralConformance.hs"-                ]-            allowedRoles =-              Set.fromList-                [ moduleRole generatedModule-                | generatedModule <- changedModules,-                  (.path) generatedModule `Set.member` expectedPaths-                ]-            impact = CheckedDiff.mappedSemanticImpact ((.mergedSpec) workspace) ((.mergedSpec) changedWorkspace)-            renderedImpact = T.unlines (renderSemanticImpact impact)-            encodedReport = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReportWithSemanticImpact defaultGate (diffSpecs ((.mergedSpec) workspace) ((.mergedSpec) changedWorkspace)) impact)))-        (.changedPaths) delta `shouldBe` expectedPaths-        (.addedPaths) delta `shouldBe` Set.empty-        (.removedPaths) delta `shouldBe` Set.empty-        assertAllowedGeneratedDelta allowedRoles baselineModules changedModules delta-        map (.declaration) impact `shouldBe` [MappedKey "AlphaPayload"]-        map (.previousConsumers) impact `shouldBe` [Set.singleton (AggregateConsumer "Alpha")]-        map (.currentConsumers) impact `shouldBe` [Set.singleton (AggregateConsumer "Alpha")]-        renderedImpact `shouldSatisfy` T.isInfixOf "previous aggregate consumers: Alpha"-        renderedImpact `shouldSatisfy` T.isInfixOf "service-conformance: impacted"-        renderedImpact `shouldSatisfy` (not . T.isInfixOf "Beta")-        encodedReport `shouldSatisfy` T.isInfixOf "\"semanticImpact\""-        encodedReport `shouldSatisfy` T.isInfixOf "\"currentConsumers\":[\"Alpha\"]"-        encodedReport `shouldSatisfy` (not . T.isInfixOf "Beta")--        _ <- executePlannedWorkspaceScaffold out workspace-        report <- executePlannedWorkspaceScaffold out changedWorkspace-        (.declarations) (report.semanticImpact) `shouldBe` [MappedKey "AlphaPayload"]-        map (.path) ((.generatedArtifactImpact) report) `shouldBe` Set.toAscList expectedPaths-        map (.category) ((.generatedArtifactImpact) report)-          `shouldSatisfy` \categories ->-            AggregateGeneratedArtifact `elem` categories-              && ServiceStructuralConformanceArtifact `elem` categories-        map (.category) ((.generatedArtifactImpact) report)-          `shouldNotContain` [BehaviorSourceMapArtifact]-        ledger <- TIO.readFile ((.recordPath) report)-        case parseWorkspaceRecord ledger of-          Just record -> record.semanticImpact `shouldSatisfy` (/= Nothing)-          Nothing -> expectationFailure "semantic-locality workspace ledger did not parse"--    it "keeps the A-only delta constant with ten unrelated aggregates" $ do-      let deltaFor count =-            withSemanticLocalityFixture ("keiro-dsl-locality-scale-" <> show count) id count $ \_ _ workspace -> do-              baseline <- shouldPlanWorkspaceSpec workspace-              changed <- shouldPlanWorkspaceSpec (mapWorkspaceSpec addAlphaPayloadOptionalField workspace)-              pure (generatedTreeDelta (map fst ((.modules) baseline)) (map fst ((.modules) changed)))-      twoAggregateDelta <- deltaFor 0-      twelveAggregateDelta <- deltaFor 10-      twelveAggregateDelta `shouldBe` twoAggregateDelta--    it "keeps nested and fixture-symbol changes local while shared and unused laws remain service-owned" $-      withSemanticLocalityFixture "keiro-dsl-locality-closure" id 0 $ \_ _ workspace -> do-        baseline <- shouldPlanWorkspaceSpec workspace-        nested <- shouldPlanWorkspaceSpec (mapWorkspaceSpec addNestedPayloadOptionalField workspace)-        fixtureChanged <- shouldPlanWorkspaceSpec (mapWorkspaceSpec changeAlphaPayloadFixtureSymbol workspace)-        let baselineModules = map fst ((.modules) baseline)-            nestedModules = map fst ((.modules) nested)-            fixtureModules = map fst ((.modules) fixtureChanged)-            nestedDelta = generatedTreeDelta baselineModules nestedModules-            fixtureDelta = generatedTreeDelta baselineModules fixtureModules-            betaPaths = Set.fromList [(.path) value | value <- baselineModules, "/Beta/" `T.isInfixOf` T.pack ((.path) value)]-            structural = generatedTextEndingIn "StructuralConformance.hs" baselineModules-            alphaHarness = generatedTextEndingIn "Alpha/Harness.hs" baselineModules-            betaHarness = generatedTextEndingIn "Beta/Harness.hs" baselineModules-            snapshot = semanticImpactSnapshotForSpec ((.mergedSpec) workspace)-        (.changedPaths) nestedDelta `shouldSatisfy` Set.null . Set.intersection betaPaths-        (.changedPaths) fixtureDelta `shouldSatisfy` Set.null . Set.intersection betaPaths-        map (.declaration) (CheckedDiff.mappedSemanticImpact ((.mergedSpec) workspace) (addNestedPayloadOptionalField ((.mergedSpec) workspace)))-          `shouldBe` [MappedKey "AlphaPayload", MappedKey "NestedPayload"]-        mappedDeclarationConsumers (semanticImpactForSpec ((.mergedSpec) workspace)) (MappedKey "SharedPayload")-          `shouldBe` [AggregateConsumer "Alpha", AggregateConsumer "Beta"]-        mappedDeclarationConsumers (semanticImpactForSpec ((.mergedSpec) workspace)) (MappedKey "UnusedPayload")-          `shouldBe` []-        (.serviceInventory) snapshot `shouldSatisfy` Set.member (MappedKey "UnusedPayload")-        T.count "fixture coverage: example.semantic-locality.SharedPayload.v1" structural `shouldBe` 1-        T.count "fixture coverage: example.semantic-locality.UnusedPayload.v1" structural `shouldBe` 1-        alphaHarness `shouldSatisfy` T.isInfixOf "SharedPayload"-        betaHarness `shouldSatisfy` T.isInfixOf "SharedPayload"-        alphaHarness `shouldNotSatisfy` T.isInfixOf "fixture coverage:"-        betaHarness `shouldNotSatisfy` T.isInfixOf "fixture coverage:"--    it "isolates comments, blank lines, and an unrelated rule to BehaviorSourceMap" $ do-      let mutations =-            [ ("comment", ("# source-only movement\n" <>)),-              ("blank-line", ("\n" <>)),-              ( "unrelated-rule",-                T.replace-                  "aggregate Alpha\n"-                  "rule unusedIsUnused : UnusedPayload -> Bool\n  ex Unused => true\n\naggregate Alpha\n"-              )-            ]-      forM_ mutations $ \(variantName, mutateSource) ->-        withSemanticLocalityFixture ("keiro-dsl-locality-source-" <> variantName) id 0 $ \root out workspace -> do-          _ <- executePlannedWorkspaceScaffold out workspace-          treeBefore <- treeSnapshot out-          let path = root </> "domain/alpha.keiro"-          original <- TIO.readFile path-          TIO.writeFile path (mutateSource original)-          moved <- loadTempWorkspace root-          report <- executePlannedWorkspaceScaffold out moved-          let overwritten = [value.path | (value, _, Overwritten) <- (.dispositions) report]-              sourceMapPath path = T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack path)-          overwritten `shouldSatisfy` \case-            [path] -> sourceMapPath path-            _ -> False-          (.declarations) (report.semanticImpact) `shouldBe` []-          map (.category) ((.generatedArtifactImpact) report) `shouldBe` [BehaviorSourceMapArtifact]-          treeAfter <- treeSnapshot out-          let treeDelta = generatedTreeDeltaFromSnapshot treeBefore treeAfter-              ledgerPath path = T.isPrefixOf "keiro-dsl-ledger.workspace." (T.pack path)-          (.changedPaths) treeDelta `shouldSatisfy` \paths ->-            Set.size paths == 2-              && any sourceMapPath paths-              && any ledgerPath paths-          filter (\(path, _) -> not (sourceMapPath path || ledgerPath path)) treeAfter-            `shouldBe` filter (\(path, _) -> not (sourceMapPath path || ledgerPath path)) treeBefore--    it "keeps complete scaffold bytes deterministic under member reordering" $-      withSemanticLocalityFixture "keiro-dsl-locality-order-a" id 0 $ \_ outA workspaceA ->-        withSemanticLocalityFixture "keiro-dsl-locality-order-b" reverse 0 $ \_ outB workspaceB -> do-          _ <- executePlannedWorkspaceScaffold outA workspaceA-          _ <- executePlannedWorkspaceScaffold outB workspaceB-          expected <- treeSnapshot outA-          treeSnapshot outB `shouldReturn` expected--  describe "generated Haskell language contract" $ do-    it "limits every representative generated module to the closed local extension set" $ do-      let allowed =-            Set.fromList-              [ "BlockArguments",-                "DeriveAnyClass",-                "DuplicateRecordFields",-                "OverloadedLabels",-                "OverloadedRecordDot",-                "QualifiedDo",-                "TemplateHaskell",-                "TypeFamilies"-              ]-          fixtures =-            [ "test/fixtures/aggregate-scalar-expressions-v2.keiro",-              "test/fixtures/nominal-scalars.keiro",-              "test/fixtures/structural-conformance.keiro",-              "test/fixtures/reservation.keiro",-              "test/fixtures/contract-v4.keiro",-              "test/fixtures/intake.keiro",-              "test/fixtures/reservation-work.keiro",-              "test/fixtures/readmodel-runtime.keiro"-            ]-      forM_ fixtures $ \fixture -> do-        modules <- scaffoldFixture fixture-        forM_ [generatedModule | generatedModule <- modules, (.kind) generatedModule == Generated] $ \generatedModule -> do-          let actual = Set.fromList (generatedLocalExtensions generatedModule)-          unless (actual `Set.isSubsetOf` allowed) $-            expectationFailure (fixture <> ":" <> (.path) generatedModule <> ": disallowed local extensions " <> show (Set.toList (actual `Set.difference` allowed)))--    it "retains specialized syntax extensions and removes GHC2024-covered pragmas" $ do-      scalar <- scaffoldFixture "test/fixtures/aggregate-scalar-expressions-v2.keiro"-      structural <- scaffoldFixture "test/fixtures/structural-conformance.keiro"-      reservation <- scaffoldFixture "test/fixtures/reservation.keiro"-      contract <- scaffoldFixture "test/fixtures/contract-v4.keiro"-      intake <- scaffoldFixture "test/fixtures/intake.keiro"-      queue <- scaffoldFixture "test/fixtures/reservation-work.keiro"-      readModel <- scaffoldFixture "test/fixtures/readmodel-runtime.keiro"-      generatedExtensionsEndingIn "ScalarAccount/Domain.hs" scalar-        `shouldBe` ["DeriveAnyClass", "TemplateHaskell"]-      generatedExtensionsEndingIn "ScalarAccount/Transducer.hs" scalar-        `shouldBe` ["BlockArguments", "OverloadedLabels", "QualifiedDo"]-      generatedExtensionsEndingIn "Nominals.hs" scalar `shouldContain` ["DeriveAnyClass", "TypeFamilies"]-      generatedExtensionsEndingIn "Nominals/Internal.hs" scalar `shouldBe` []-      generatedExtensionsEndingIn "StructuralProjections.hs" structural `shouldBe` ["TypeFamilies"]-      let structuralShapeExtensions =-            [ generatedLocalExtensions generatedModule-            | generatedModule <- structural,-              "/Structural/Shape/" `T.isInfixOf` T.pack ((.path) generatedModule)-            ]-      structuralShapeExtensions `shouldSatisfy` all null-      generatedExtensionsEndingIn "Projection.hs" reservation `shouldBe` []-      generatedExtensionsEndingIn "ReplayAudit.hs" reservation `shouldBe` []-      generatedExtensionsEndingIn "Contract.hs" contract `shouldBe` []-      generatedExtensionsEndingIn "Inbox.hs" intake `shouldBe` []-      generatedExtensionsEndingIn "Queue.hs" queue `shouldBe` []-      generatedExtensionsEndingIn "ReadModel.hs" readModel `shouldBe` []--    it "conditions label and derivation extensions on emitted syntax while record defaults stay manifest-owned" $ do-      mappedGuardSource <- readTestText "test/fixtures/mapped-guard.keiro"-      mappedGuardParsed <- case parseSource "mapped-guard-no-expression.keiro" (T.replace "guard current == current ; " "" mappedGuardSource) of-        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-        Right parsed -> pure parsed-      let mappedGuardService = checkedSource mappedGuardParsed-          mappedGuard = scaffoldServiceModules (defaultContext ((checkedSpec mappedGuardService).context)) mappedGuardService-      registerFree <- scaffoldFixture "test/fixtures/order.keiro"-      readModels <- scaffoldFixture "test/fixtures/readmodel.keiro"-      snapshot <- scaffoldFixture "test/fixtures/reservation-snapshot.keiro"-      ordinary <- scaffoldFixture "test/fixtures/reservation.keiro"-      generatedExtensionsEndingIn "Holder/Domain.hs" mappedGuard `shouldBe` ["TemplateHaskell"]-      generatedExtensionsEndingIn "Holder/Codec.hs" mappedGuard `shouldBe` []-      generatedExtensionsEndingIn "Holder/Transducer.hs" mappedGuard-        `shouldBe` ["BlockArguments", "QualifiedDo"]-      generatedExtensionsEndingIn "Holder/Harness.hs" mappedGuard `shouldBe` ["OverloadedLabels"]-      generatedExtensionsEndingIn "Order/Harness.hs" registerFree `shouldBe` []-      generatedExtensionsEndingIn "TransferDecisions/ReadModel.hs" readModels `shouldBe` []-      generatedExtensionsEndingIn "Subscriptions/ReadModel.hs" readModels `shouldBe` []-      generatedExtensionsEndingIn "Reservation/Domain.hs" snapshot `shouldContain` ["DeriveAnyClass"]-      generatedExtensionsEndingIn "Reservation/Domain.hs" ordinary `shouldNotContain` ["DeriveAnyClass"]--      disjoint <--        parseInlineSpec "<disjoint-contract>" $-          T.unlines-            [ "language keiro-dsl 4",-              "context language-contract",-              "contract disjoint {",-              "  schemaVersion 1",-              "  discriminator kind",-              "  topic events \"events\"",-              "  event First on events { first: text }",-              "  event Second on events { second: text }",-              "}"-            ]-      emptyPayload <--        parseInlineSpec "<empty-contract>" $-          T.unlines-            [ "language keiro-dsl 4",-              "context language-contract",-              "contract empty {",-              "  schemaVersion 1",-              "  discriminator kind",-              "  topic events \"events\"",-              "  event Empty on events { }",-              "}"-            ]-      let contractExtensions spec =-            generatedExtensionsEndingIn-              "Contract.hs"-              [ generatedModule-              | contractNode <- [contractNode | NContract contractNode <- (.nodes) spec],-                generatedModule <- scaffoldContract (defaultContext (spec.context)) contractNode-              ]-      contractExtensions disjoint `shouldBe` []-      contractExtensions emptyPayload `shouldBe` []--  describe "manifest (M2)" $ do-    it "lists exactly the modules the scaffolder produced" $ do-      mods <- scaffoldFixture "test/fixtures/reservation.keiro"-      service <- checkedServiceOf "test/fixtures/reservation.keiro"-      let manifest = renderManifestForService "reservation.keiro" mods service-          expectedNames = sort (map (moduleNameOf . (.path)) mods)-      assertGeneratedHaskellContract "reservation.keiro" manifest-      -- every produced module name appears in the manifest…-      mapM_ (\m -> (m `T.isInfixOf` manifest) `shouldBe` True) expectedNames-      -- …and the module list is exactly the scaffolder's output set.-      expectedNames-        `shouldBe` sort-          [ "Generated.HospitalCapacity.Reservation.Codec",-            "Generated.HospitalCapacity.Reservation.BehaviorContract",-            "Generated.HospitalCapacity.Reservation.Domain",-            "Generated.HospitalCapacity.Reservation.EventStream",-            "Generated.HospitalCapacity.Reservation.Harness",-            "Generated.HospitalCapacity.Reservation.Projection",-            "Generated.HospitalCapacity.Reservation.Transducer",-            "Generated.HospitalCapacity.Nominals",-            "Generated.HospitalCapacity.Nominals.Internal",-            "Generated.HospitalCapacity.ReplayAudit",-            "HospitalCapacity.Reservation.BehaviorHoles",-            "HospitalCapacity.Reservation.Holes"-          ]-    it "derives the dependency set from the node kinds present (aggregate)" $ do-      service <- checkedServiceOf "test/fixtures/reservation.keiro"-      manifestDependenciesForService service `shouldBe` ["aeson", "base", "keiki", "keiro", "text"]-    it "derives the process dependency set, including worker-policy runtime imports" $ do-      service <- checkedServiceOf "test/fixtures/hospital-surge.keiro"-      let dependencies = manifestDependenciesForService service-      mapM_ (\dependency -> dependencies `shouldContain` [dependency]) ["time", "uuid", "shibuya-core", "keiki", "keiro"]-    it "uses the registered shibuya-core package name for router scaffolds" $ do-      service <- checkedServiceOf "test/fixtures/incident-paging/incident-paging.keiro"-      let dependencies = manifestDependenciesForService service-      mapM_ (\dependency -> dependencies `shouldContain` [dependency]) ["effectful-core", "keiro", "shibuya-core"]-      dependencies `shouldNotContain` ["shibuya"]--  describe "service conformance facade (plan 188 M2)" $ do-    it "normalizes aggregate and read-model checks behind one base-only API" $ do-      service <- checkedServiceOf "test/fixtures/transfer-routing.keiro"-      let ctx = defaultContext ((checkedSpec service).context)-      case serviceHarnessModule ctx service of-        Left duplicates -> expectationFailure ("unexpected duplicate fact keys: " <> show duplicates)-        Right facade -> do-          committed <- readTestText ("test/conformance-newsurface/" <> (.path) facade)-          normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) facade)-          moduleNameOf ((.path) facade) `shouldBe` "Generated.TransferRouting.Conformance"-          (.text) facade `shouldSatisfy` T.isInfixOf ".harnessAssertions"-          (.text) facade `shouldSatisfy` T.isInfixOf ".readModelFactResults"-          (.text) facade `shouldSatisfy` T.isInfixOf "aggregate/Hospital/"-          (.text) facade `shouldSatisfy` T.isInfixOf "readmodel/hospital_load/"-          (.text) facade `shouldSatisfy` T.isInfixOf "qualified as Hospital"-          (.text) facade `shouldSatisfy` T.isInfixOf "qualified as HospitalLoad"-          (.text) facade `shouldNotSatisfy` T.isInfixOf "qualified as Harness"-          (.text) facade `shouldNotSatisfy` T.isInfixOf "TransferRouting.Hospital.Holes"-    it "projects process, router, and workflow facts with qualified stable keys" $ do-      processService <- checkedServiceOf "test/fixtures/hospital-surge.keiro"-      routerService <- checkedServiceOf "test/fixtures/incident-paging/incident-paging.keiro"-      workflowService <- checkedServiceOf "test/fixtures/workflow-evolution.keiro"-      let select predicate = filter predicate . (.nodes) . checkedSpec-          factNodes =-            select (\case NProcess {} -> True; _ -> False) processService-              <> select (\case NRouter {} -> True; _ -> False) routerService-              <> select (\case NWorkflow {} -> True; _ -> False) workflowService-          baseSpec = checkedSpec processService-          service = checkedServiceWithSpec (specWithNodes factNodes baseSpec) processService-          ctx = defaultContext (baseSpec.context)-      forM_-        [ "process/HospitalSurge/maxAttempts",-          "router/PagingRouter/dispatchCommand",-          "workflow/HospitalTransferReservation/body"-        ]-        (\key -> serviceConformanceFactKeys service `shouldSatisfy` elem key)-      case serviceHarnessModule ctx service of-        Left duplicates -> expectationFailure ("unexpected duplicate fact keys: " <> show duplicates)-        Right facade -> do-          (.text) facade `shouldSatisfy` T.isInfixOf ".processHarnessValues"-          (.text) facade `shouldSatisfy` T.isInfixOf ".routerHarnessValues"-          (.text) facade `shouldSatisfy` T.isInfixOf ".workflowFactValues"-    it "uses the shared context-level placement policy" $ do-      service <- checkedServiceOf "test/fixtures/contract-v4.keiro"-      let ctx = Context {name = "modules", moduleRoot = "Mori", placement = CollocatedLeaf}-      serviceConformanceModuleName ctx `shouldBe` "Mori.Modules.Generated.Conformance"-      case serviceHarnessModule ctx service of-        Left duplicates -> expectationFailure ("unexpected duplicate fact keys: " <> show duplicates)-        Right facade -> do-          (.text) facade `shouldSatisfy` T.isInfixOf "runServiceConformanceChecks = pure []"-          (.text) facade `shouldSatisfy` T.isInfixOf "serviceConformanceFacts = []"-    it "adds one facade only to configured single-file plans and exposes only it" $ do-      service <- checkedServiceOf "test/fixtures/reservation.keiro"-      let ctx = defaultContext ((checkedSpec service).context)-          runtimePackage = RuntimePackageName "reservation-runtime"-      unconfigured <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)-      configured <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffoldWithRuntimePackage (Just runtimePackage) ctx service)-      let facadeName = serviceConformanceModuleName ctx-          facades = [moduleValue | moduleValue <- configured, moduleNameOf ((.path) moduleValue) == facadeName]-          manifest = renderManifestForServiceWithFacade (Just facadeName) "reservation.keiro" configured service-      length configured `shouldBe` length unconfigured + 1-      length facades `shouldBe` 1-      manifest `shouldSatisfy` T.isInfixOf ("exposed-modules:\n    " <> facadeName)-      T.count facadeName manifest `shouldBe` 1-    it "emits one context-level facade for a multi-member workspace regardless of member order" $ do-      canonical <- shouldComposeWorkspace canonicalWorkspacePath-      reordered <- shouldComposeWorkspace "test/fixtures/workspace/service-reordered.keiro-workspace"-      let runtimePackage = Just (RuntimePackageName "demo-runtime")-          plan workspace =-            planWorkspaceScaffoldWithRuntimePackageAndGoldens [] runtimePackage "goldens" (workspaceContext workspace) workspace-          facades workspacePlan =-            [ ((.text) moduleValue, provenance)-            | (moduleValue, provenance) <- (.modules) workspacePlan,-              ".Conformance" `T.isSuffixOf` moduleNameOf ((.path) moduleValue)-            ]-      canonicalPlan <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (plan canonical)-      reorderedPlan <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (plan reordered)-      facades canonicalPlan `shouldBe` facades reorderedPlan-      map snd (facades canonicalPlan) `shouldBe` [ContextLevel]-    it "refuses duplicate normalized fact keys before planning writes" $ do-      service <- checkedServiceOf "test/fixtures/hospital-surge.keiro"-      let spec = checkedSpec service-          processes = [node | node@NProcess {} <- (.nodes) spec]-          duplicated = checkedServiceWithSpec (specWithNodes (processes <> processes) spec) service-      serviceHarnessModule (defaultContext (spec.context)) duplicated `shouldSatisfy` isLeft--  describe "runnable service conformance package (plan 188 M3)" $ do-    it "uses readable ordinary names and collision-safe punctuation encoding" $ do-      cabaliseConformanceService "mori" `shouldBe` "mori"-      cabaliseConformanceService "mori_core" `shouldNotBe` cabaliseConformanceService "mori-core"-      cabaliseConformanceService "Mori" `shouldNotBe` cabaliseConformanceService "mori"-      conformancePackageDirectory (WorkspaceConformanceService "mori") `shouldBe` "keiro-dsl-conformance.workspace.mori"-      conformancePackageDirectory (StandaloneConformanceService "mori") `shouldBe` "keiro-dsl-conformance.mori"-    it "plans one base-only package and round-trips its complete generated record" $ do-      service <- checkedServiceOf "test/fixtures/hospital-surge.keiro"-      let runtimePackage = RuntimePackageName "hospital-runtime"-          facade = "Generated.HospitalSurge.Conformance"-      plan <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planConformancePackage (StandaloneConformanceService "hospital-surge") runtimePackage facade service)-      (.packageName) plan `shouldBe` "keiro-hospital-surge-conformance"-      length [file | file <- (.files) plan, takeExtension ((.path) file) == ".cabal"] `shouldBe` 1-      cabalFile <- case [file | file <- (.files) plan, takeExtension ((.path) file) == ".cabal"] of-        [file] -> pure file-        files -> expectationFailure ("expected one Cabal file, got " <> show (map (.path) files)) >> fail "unreachable"-      let cabalText = (.text) cabalFile-      cabalText `shouldSatisfy` T.isInfixOf "base >=4.18 && <5"-      T.lines cabalText `shouldSatisfy` (\lines' -> case lines' of first : _ -> first == "cabal-version: 3.0"; [] -> False)-      cabalText `shouldSatisfy` T.isInfixOf "hospital-runtime"-      cabalText `shouldSatisfy` T.isInfixOf "ghc-options: -Wall"-      cabalText `shouldNotSatisfy` T.isInfixOf "    , keiro-dsl\n"-      recordFile <- case [file | file <- (.files) plan, (.path) file == conformanceRecordFileName] of-        [file] -> pure file-        files -> expectationFailure ("expected one package record, got " <> show (map (.path) files)) >> fail "unreachable"-      let recordText = (.text) recordFile-      parseConformancePackageRecord recordText-        `shouldBe` Just-          ConformancePackageRecord-            { schema = 1,-              serviceKey = (.serviceKey) plan,-              runtimePackage = runtimePackage,-              facadeModule = facade,-              files = [((.kind) file, (.path) file) | file <- (.files) plan]-            }-    it "tolerates future rows and JSON keys while round-tripping awkward safe paths" $ do-      let recordText =-            T.unlines-              [ "keiro-dsl conformance ledger v1",-                "service-key standalone hospital-surge",-                "runtime-package hospital-runtime",-                "facade-module Generated.HospitalSurge.Conformance",-                "file {\"kind\":\"generated\",\"path\":\"generated/file with space.hs\",\"future-key\":true}",-                "future-row {\"value\":1}"-              ]-          expected =-            ConformancePackageRecord-              { schema = 1,-                serviceKey = StandaloneConformanceService "hospital-surge",-                runtimePackage = RuntimePackageName "hospital-runtime",-                facadeModule = "Generated.HospitalSurge.Conformance",-                files = [(Generated, "generated/file with space.hs")]-              }-      parseConformancePackageRecord recordText `shouldBe` Just expected-      parseConformancePackageRecord (renderConformancePackageRecord expected) `shouldBe` Just expected-      parseConformancePackageRecord (T.replace "generated/file with space.hs" "../escape.hs" recordText)-        `shouldBe` Nothing-      parseConformancePackageRecord (T.replace "future-row {\"value\":1}" "file {\"kind\":\"generated\",\"path\":\"GENERATED/FILE WITH SPACE.HS\"}" recordText)-        `shouldBe` Nothing-    it "compares unique facts by key and distinguishes mismatch, missing, and unexpected" $ do-      compareConformanceFacts [("a", "1"), ("b", "2"), ("d", "4")] [("c", "3"), ("a", "1"), ("b", "9")]-        `shouldBe` Right-          [ ConformanceFactMatch "a" "1",-            ConformanceFactMismatch "b" "2" "9",-            ConformanceFactUnexpected "c" "3",-            ConformanceFactMissing "d" "4"-          ]-      compareConformanceFacts [("a", "1"), ("a", "2")] []-        `shouldBe` Left [DuplicateFactKey ExpectedFact "a"]-    it "creates once, reports generated files unchanged, and preserves accepted expectations" $ do-      withTempDirectory "keiro-dsl-conformance-package" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/hospital-surge.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            runtimePackage = RuntimePackageName "hospital-runtime"-        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffoldWithRuntimePackage (Just runtimePackage) ctx service)-        first <- executeServiceScaffoldWithRuntimePackage (Just runtimePackage) out False "hospital-surge.keiro" ((.sourceLanguage) parsed) ctx service modules-        firstReport <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure first-        firstPackage <- maybe (expectationFailure "expected conformance package report" >> fail "unreachable") pure ((.conformancePackage) firstReport)-        let packageRoot = out </> conformancePackageDirectory (StandaloneConformanceService ((.name) ctx))-            expectationsPath = packageRoot </> "src/KeiroConformance/Expectations.hs"-            accepted = "module KeiroConformance.Expectations where\n-- accepted by the application\n"-        map snd ((.dispositions) firstPackage) `shouldContain` [ConformanceCreated]-        TIO.writeFile expectationsPath accepted-        second <- executeServiceScaffoldWithRuntimePackage (Just runtimePackage) out True "hospital-surge.keiro" ((.sourceLanguage) parsed) ctx service modules-        secondReport <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure second-        secondPackage <- maybe (expectationFailure "expected conformance package report" >> fail "unreachable") pure ((.conformancePackage) secondReport)-        TIO.readFile expectationsPath `shouldReturn` accepted-        [ disposition-          | (file, disposition) <- (.dispositions) secondPackage,-            (.kind) file == Generated-          ]-          `shouldSatisfy` all (== ConformanceUnchanged)-        [ disposition-          | (file, disposition) <- (.dispositions) secondPackage,-            (.kind) file == HoleStub-          ]-          `shouldBe` [ConformanceSkipped]-    -- Migration used to be planned only when the run also planned a conformance-    -- package, so a spec that stopped generating one left its legacy record-    -- behind — and unreadable, since the current reader has no legacy parser.-    -- See ExecPlan 199.-    it "migrates an orphaned legacy conformance record even with no package planned" $-      withTempDirectory "keiro-dsl-orphan-conformance-ledger" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/hospital-surge.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            orphanDirectory = out </> "keiro-dsl-conformance.standalone.retired-service"-            orphanPath = orphanDirectory </> legacyConformanceRecordFileName-            -- No --runtime-package, so this run plans no conformance package at-            -- all: the record below belongs to a package that no longer exists.-            run apply = do-              modules <--                either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure $-                  planTestServiceScaffoldWithRuntimePackage Nothing ctx service-              executeServiceScaffoldWithRuntimePackageAndNameMigrations-                Nothing-                apply-                out-                False-                "hospital-surge.keiro"-                ((.sourceLanguage) parsed)-                ctx-                service-                modules-        -- Build the orphan from a record the current writer produced, so the-        -- test exercises the discovery change and not a hand-typed format.-        withTempDirectory "keiro-dsl-orphan-source" $ \source -> do-          let sourceRuntime = RuntimePackageName "retired-runtime"-              sourcePackageRoot = source </> conformancePackageDirectory (StandaloneConformanceService ((.name) ctx))-          sourceModules <--            either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure $-              planTestServiceScaffoldWithRuntimePackage (Just sourceRuntime) ctx service-          _ <--            executeServiceScaffoldWithRuntimePackageAndNameMigrations-              (Just sourceRuntime)-              False-              source-              False-              "hospital-surge.keiro"-              ((.sourceLanguage) parsed)-              ctx-              service-              sourceModules-              >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-          ledger <- TIO.readFile (sourcePackageRoot </> conformanceLedgerFileName)-          record <--            maybe (expectationFailure "conformance ledger did not parse" >> fail "unreachable") pure $-              parseConformancePackageRecord ledger-          createDirectoryIfMissing True orphanDirectory-          TIO.writeFile-            orphanPath-            ( T.unlines $-                [line | line <- T.lines ledger, isGeneratedBannerLine line]-                  <> [ "schema 1",-                       "service-key standalone " <> (.name) ctx,-                       "runtime-package " <> (.unRuntimePackageName) ((.runtimePackage) record),-                       "facade-module " <> (.facadeModule) record-                     ]-                  <> [ "file "-                         <> (case fileKind of Generated -> "generated"; HoleStub -> "create-once")-                         <> " "-                         <> T.pack path-                     | (fileKind, path) <- (.files) record-                     ]-            )-        refused <- run False-        refused `shouldSatisfy` \case-          Left [SidecarMigrationRequired [move]] ->-            (.moveDisposition) move == ConvertLegacyConformanceLedger-          _ -> False--        applied <- run True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        map (.moveDisposition) ((.sidecarMoves) applied) `shouldBe` [ConvertLegacyConformanceLedger]-        doesFileExist orphanPath `shouldReturn` False-        doesFileExist (orphanDirectory </> conformanceLedgerFileName) `shouldReturn` True--    it "converts a legacy conformance record losslessly and keeps service-key mismatch refusal" $-      withTempDirectory "keiro-dsl-conformance-ledger-migration" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/hospital-surge.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            runtimePackage = RuntimePackageName "hospital-runtime"-            packageRoot = out </> conformancePackageDirectory (StandaloneConformanceService ((.name) ctx))-            currentPath = packageRoot </> conformanceLedgerFileName-            legacyPath = packageRoot </> legacyConformanceRecordFileName-            backupPath = out </> ".keiro-dsl-name-migrations/sidecar-v1" </> conformancePackageDirectory (StandaloneConformanceService ((.name) ctx)) </> legacyConformanceRecordFileName-        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffoldWithRuntimePackage (Just runtimePackage) ctx service)-        let run apply =-              executeServiceScaffoldWithRuntimePackageAndNameMigrations-                (Just runtimePackage)-                apply-                out-                False-                "hospital-surge.keiro"-                ((.sourceLanguage) parsed)-                ctx-                service-                modules-            renderLegacyKey (WorkspaceConformanceService value) = "workspace " <> value-            renderLegacyKey (StandaloneConformanceService value) = "standalone " <> value-            renderLegacyKind Generated = "generated"-            renderLegacyKind HoleStub = "create-once"-        _ <- run False >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        currentContents <- TIO.readFile currentPath-        record <- maybe (expectationFailure "fresh conformance ledger did not parse" >> fail "unreachable") pure (parseConformancePackageRecord currentContents)-        let legacyRecord =-              conformanceRecordWithFiles-                [ (fileKind, if path == conformanceLedgerFileName then legacyConformanceRecordFileName else path)-                | (fileKind, path) <- record.files-                ]-                record-            legacyContents =-              T.unlines $-                [line | line <- T.lines currentContents, isGeneratedBannerLine line]-                  <> [ "schema 1",-                       "service-key " <> renderLegacyKey ((.serviceKey) legacyRecord),-                       "runtime-package " <> (.unRuntimePackageName) legacyRecord.runtimePackage,-                       "facade-module " <> (.facadeModule) legacyRecord-                     ]-                  <> ["file " <> renderLegacyKind fileKind <> " " <> T.pack path | (fileKind, path) <- (.files) legacyRecord]-        renameFile currentPath legacyPath-        TIO.writeFile legacyPath legacyContents-        migrationTreeBefore <- treeSnapshot out-        refused <- run False-        refused `shouldSatisfy` \case-          Left [SidecarMigrationRequired [move]] -> (.moveDisposition) move == ConvertLegacyConformanceLedger-          _ -> False-        treeSnapshot out `shouldReturn` migrationTreeBefore-        applied <- run True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure-        map (.moveDisposition) ((.sidecarMoves) applied) `shouldBe` [ConvertLegacyConformanceLedger]-        doesFileExist legacyPath `shouldReturn` False-        TIO.readFile backupPath `shouldReturn` legacyContents-        migrated <- TIO.readFile currentPath-        (.serviceKey) <$> parseConformancePackageRecord migrated-          `shouldBe` Just (StandaloneConformanceService ((.name) ctx))--        TIO.writeFile-          currentPath-          ( T.replace-              ("service-key standalone " <> (.name) ctx)-              "service-key standalone another-service"-              migrated-          )-        mismatchBefore <- treeSnapshot out-        mismatch <- run False-        mismatch `shouldSatisfy` \case-          Left [ConformancePackageRefusal ConformancePackageRecordMismatch {}] -> True-          _ -> False-        treeSnapshot out `shouldReturn` mismatchBefore-    it "refuses a bannerless package file before changing any runtime byte" $ do-      withTempDirectory "keiro-dsl-conformance-atomic" $ \out -> do-        parsed <- parsedSourceOf "test/fixtures/hospital-surge.keiro"-        let service = checkedSource parsed-            spec = checkedSpec service-            ctx = defaultContext (spec.context)-            runtimePackage = RuntimePackageName "hospital-runtime"-        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffoldWithRuntimePackage (Just runtimePackage) ctx service)-        executeServiceScaffoldWithRuntimePackage (Just runtimePackage) out False "hospital-surge.keiro" ((.sourceLanguage) parsed) ctx service modules-          >>= either (\failure -> expectationFailure (show failure)) (const (pure ()))-        facade <- case [moduleValue | moduleValue <- modules, ".Conformance" `T.isSuffixOf` moduleNameOf ((.path) moduleValue)] of-          [moduleValue] -> pure moduleValue-          values -> expectationFailure ("expected one facade, got " <> show (map (.path) values)) >> fail "unreachable"-        let facadePath = out </> (.path) facade-            serviceKey = (.name) ctx-            cabalPath = out </> conformancePackageDirectory (StandaloneConformanceService serviceKey) </> T.unpack ("keiro-" <> cabaliseConformanceService serviceKey <> "-conformance.cabal")-        TIO.appendFile facadePath "-- would be overwritten if runtime execution began\n"-        TIO.writeFile cabalPath "hand-owned cabal file\n"-        packageTree <- treeSnapshot out-        refused <- executeServiceScaffoldWithRuntimePackage (Just runtimePackage) out False "hospital-surge.keiro" ((.sourceLanguage) parsed) ctx service modules-        refused `shouldSatisfy` isLeft-        treeSnapshot out `shouldReturn` packageTree-    it "keeps a two-aggregate workspace at exactly one Cabal package" $ do-      withTempDirectory "keiro-dsl-conformance-workspace" $ \out -> do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        let runtimePackage = Just (RuntimePackageName "workspace-runtime")-        plan <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planWorkspaceScaffoldWithRuntimePackageAndGoldens [] runtimePackage "goldens" (workspaceContext workspace) workspace)-        length [() | NAggregate {} <- (.nodes) (checkedSpec (checkedWorkspace workspace))] `shouldBe` 2-        executeWorkspaceScaffold out False plan >>= either (\failure -> expectationFailure (show failure)) (const (pure ()))-        packageDirectories <- filter (T.isPrefixOf "keiro-dsl-conformance.workspace." . T.pack) <$> listDirectory out-        packageDirectories `shouldBe` ["keiro-dsl-conformance.workspace.demo-project"]-        case packageDirectories of-          [packageDirectory] -> do-            cabalFiles <- filter ((== ".cabal") . takeExtension) <$> listDirectory (out </> packageDirectory)-            length cabalFiles `shouldBe` 1-          _ -> expectationFailure "expected one package directory"-    it "scaffolds the multi-member proof idempotently through the public CLI" $ do-      withTempDirectory "keiro-dsl-conformance-proof-cli" $ \base -> do-        let fixture = "test/conformance-service-package"-            copied = base </> "fixture"-            out = copied </> "runtime/src"-            sourcePaths =-              [ "service.keiro-workspace",-                "domain/alpha.keiro",-                "domain/beta.keiro",-                "domain/evidence.keiro",-                "domain/shared.keiro"-              ]-        fixtureManifest <- resolveTestPath (fixture </> "service.keiro-workspace") >>= canonicalizePath-        let fixtureRoot = takeDirectory fixtureManifest-        forM_ sourcePaths $ \relative -> TIO.readFile (fixtureRoot </> relative) >>= writeFileWithParents (copied </> relative)-        (firstCode, firstOut, firstErr) <- runKeiroDsl ["scaffold", copied </> "service.keiro-workspace", "--out", out]-        unless (firstCode == ExitSuccess) (expectationFailure (firstOut <> firstErr))-        firstTree <- treeSnapshot out-        length [path | (path, _) <- firstTree, takeExtension path == ".cabal"] `shouldBe` 1-        length [path | (path, _) <- firstTree, "Generated/Conformance.hs" `T.isSuffixOf` T.pack path] `shouldBe` 1-        let recordPath = out </> conformancePackageDirectory (WorkspaceConformanceService "workspace-proof") </> conformanceRecordFileName-        record <- parseConformancePackageRecord <$> TIO.readFile recordPath-        (.serviceKey) <$> record `shouldBe` Just (WorkspaceConformanceService "workspace-proof")-        (secondCode, secondOut, secondErr) <- runKeiroDsl ["scaffold", copied </> "service.keiro-workspace", "--out", out]-        unless (secondCode == ExitSuccess) (expectationFailure (secondOut <> secondErr))-        secondErr `shouldSatisfy` isInfixOfString "keiro-workspace-proof-conformance.cabal (unchanged)"-        secondErr `shouldSatisfy` isInfixOfString "Expectations.hs (skipped: already present)"-        secondErr `shouldSatisfy` isInfixOfString "Generated.Conformance"-        treeSnapshot out `shouldReturn` firstTree-    it "keeps Expectations fixed and turns the generated target red for a changed workflow fact" $ do-      withTempDirectory "keiro-dsl-conformance-proof-mutation" $ \base -> do-        fixtureManifest <- resolveTestPath "test/conformance-service-package/service.keiro-workspace" >>= canonicalizePath-        let fixtureRoot = takeDirectory fixtureManifest-        let copied = base </> "fixture"-            out = copied </> "runtime/src"-            path = copied </> "domain/evidence.keiro"-            expectationsPath = out </> "keiro-dsl-conformance.workspace.workspace-proof/src/KeiroConformance/Expectations.hs"-        copyTextTree fixtureRoot copied-        acceptedExpectations <- TIO.readFile expectationsPath-        TIO.readFile path-          >>= TIO.writeFile path . T.replace "name \"workspace-proof-workflow\"" "name \"workspace-proof-workflow-v2\""-        (scaffoldCode, scaffoldOut, scaffoldErr) <- runKeiroDsl ["scaffold", copied </> "service.keiro-workspace", "--out", out]-        unless (scaffoldCode == ExitSuccess) (expectationFailure (scaffoldOut <> scaffoldErr))-        TIO.readFile expectationsPath `shouldReturn` acceptedExpectations-        let repositoryRoot = takeDirectory (takeDirectory (takeDirectory fixtureRoot))-            projectPath = base </> "mutation.project"-            buildDirectory = base </> "dist-newstyle"-            packageRoot = out </> "keiro-dsl-conformance.workspace.workspace-proof"-        localSourcePackages <--          filterM-            doesDirectoryExist-            [ repositoryRoot </> "keiro",-              repositoryRoot </> "keiro-core"-            ]-        -- Compiling this generated package is a repository integration proof:-        -- it deliberately builds against the sibling keiro and keiro-core-        -- source packages. The package-owned scaffold and immutable--        -- Expectations assertions above remain active in an unpacked sdist.-        unless (null localSourcePackages) $ do-          let packageRoots = localSourcePackages <> [copied </> "runtime", packageRoot]-          TIO.writeFile-            projectPath-            ( T.unlines $-                ["packages:"]-                  <> map (("  " <>) . T.pack) packageRoots-                  <> [ "",-                       "allow-newer:",-                       "  haxl:time"-                     ]-            )-          (testCode, testOut, testErr) <--            readProcessWithExitCode-              "cabal"-              [ "test",-                "--project-file=" <> projectPath,-                "--builddir=" <> buildDirectory,-                "keiro-workspace-proof-conformance"-              ]-              ""-          testCode `shouldNotBe` ExitSuccess-          (testOut <> testErr)-            `shouldSatisfy` isInfixOfString "FAIL  workflow/WorkspaceProofWorkflow/name expected=\"workspace-proof-workflow\" actual=\"workspace-proof-workflow-v2\""--  describe "new <kind> skeletons (M5)" $ do-    forM_ skeletonKinds $ \skeletonKind ->-      it ("the " <> T.unpack skeletonKind <> " skeleton selects and preserves the active authoring language") $-        assertSkeletonUsesAuthoringLanguage skeletonKind-    it "every skeleton parses and validates with zero error diagnostics" $-      mapM_ assertSkeletonValid skeletonKinds-    it "every skeleton passes the scaffold refusal gates" $-      mapM_ assertSkeletonScaffoldable skeletonKinds-    -- `derive … hole` is mandatory emit grammar. While it carried a warning, a-    -- freshly generated emit service could never satisfy the documented CI-    -- recipe, no matter what its author did. See ExecPlan 199.-    it "every skeleton without a confirmed benign inversion satisfies the documented --deny-warnings CI gate" $-      withTempDirectory "keiro-dsl-skeleton-deny" $ \out ->-        -- router and process are deliberately absent: their idiomatic-        -- on-duplicate/on-reject spellings are confirmed benign inversions-        -- (RouterBenignInversion/ProcessBenignInversion), so those services-        -- gate CI with a selective --deny list rather than --deny-warnings.-        forM_ ["emit", "intake", "aggregate", "contract", "workqueue", "workflow"] $ \kind ->-          case skeletonFor kind of-            Left err -> expectationFailure (T.unpack err)-            Right source -> do-              let specPath = out </> T.unpack kind <> ".keiro"-              TIO.writeFile specPath source-              (exitCode, stdoutText, stderrText) <--                runKeiroDsl ["check", specPath, "--min-language", "4", "--deny-warnings"]-              unless (exitCode == ExitSuccess) $-                expectationFailure (T.unpack kind <> " skeleton failed the gate:\n" <> stdoutText <> stderrText)-              stderrText `shouldNotContain` "escalated to failure"-    it "rejects an unknown kind with a helpful message" $-      case skeletonFor "bogus" of-        Left msg -> ("Valid kinds:" `T.isInfixOf` msg) `shouldBe` True-        Right _ -> expectationFailure "expected an error for an unknown kind"--  describe "firewall self-check (M3)" $ do-    it "flags a forbidden operator in a Generated module" $ do-      let m = ScaffoldModule {path = "Gen/Foo.hs", text = "x = a ./= b", kind = Generated, origin = "test"}-      firewallBreaches [m] `shouldBe` [("Gen/Foo.hs", "./=", 1)]-    it "ignores forbidden operators in a HoleStub module (holes own them)" $ do-      let m = ScaffoldModule {path = "Foo/Holes.hs", text = "x = lit 1 .== y", kind = HoleStub, origin = "test"}-      firewallBreaches [m] `shouldBe` []-    it "matches `lit` as a word, not a substring of quality/split" $ do-      let clean = ScaffoldModule {path = "Gen/Q.hs", text = "quality = split facility", kind = Generated, origin = "test"}-          dirty = ScaffoldModule {path = "Gen/L.hs", text = "v = lit foo", kind = Generated, origin = "test"}-      firewallBreaches [clean] `shouldBe` []-      firewallBreaches [dirty] `shouldBe` [("Gen/L.hs", "lit", 1)]-    it "skips strings and comments and maximal-munches symbolic tokens" $ do-      let clean = syntheticGenerated "Gen/Clean.hs" "wire = \"lit .== B.slot\"\n-- x =: y\nx = a .<= b"-          dirty = syntheticGenerated "Gen/Dirty.hs" "x = a .< b\ny = c =: d"-      firewallBreaches [clean] `shouldBe` [("Gen/Clean.hs", ".<=", 3)]-      firewallBreaches [dirty] `shouldBe` [("Gen/Dirty.hs", ".<", 1), ("Gen/Dirty.hs", "=:", 2)]-    it "guards keiki imports while allowing the generated Core allowlist" $ do-      let forbidden = syntheticGenerated "Gen/Builder.hs" "import Keiki.Builder"-          restricted = syntheticGenerated "Gen/CoreBad.hs" "import Keiki.Core (lit)"-          allowed = syntheticGenerated "Gen/CoreGood.hs" "import Keiki.Core (RegFile (..), HsPred, step)"-      firewallBreaches [forbidden] `shouldBe` [("Gen/Builder.hs", "import:Keiki.Builder", 1)]-      firewallBreaches [restricted] `shouldBe` [("Gen/CoreBad.hs", "import:Keiki.Core", 1)]-      firewallBreaches [allowed] `shouldBe` []-    it "exempts only the authoritative generated transducer module path" $ do-      let expressions = syntheticGenerated "Gen/Aggregate/Expressions.hs" "import Keiki.Core qualified as K\nx = K.lit 1"-          transducer = syntheticGenerated "Gen/Aggregate/Transducer.hs" "import Keiki.Builder qualified as B\nx = B.slot"-          ordinary = syntheticGenerated "Gen/Aggregate/Projection.hs" "import Keiki.Builder qualified as B"-      firewallBreaches [expressions, transducer]-        `shouldBe` [("Gen/Aggregate/Expressions.hs", "import:Keiki.Core", 1)]-      firewallBreaches [ordinary] `shouldBe` [("Gen/Aggregate/Projection.hs", "import:Keiki.Builder", 1)]-    it "finds no breach in real scaffolder output (aggregate + process fixtures)" $ do-      aggMods <- scaffoldFixture "test/fixtures/reservation.keiro"-      procMods <- legacyScaffoldProcessFixture "test/fixtures/hospital-surge.keiro"-      firewallBreaches (aggMods <> procMods) `shouldBe` []--  describe "generated provenance banners (plan 182 M4)" $ do-    it "stamps the running package version, effective language, and module origin" $ do-      service <- checkedServiceOf "test/fixtures/contract-v4.keiro"-      let ctx = defaultContext ((checkedSpec service).context)-      case planTestServiceScaffold ctx service of-        Left refusals -> expectationFailure (show refusals)-        Right modules -> do-          let generated = [moduleValue | moduleValue <- modules, (.kind) moduleValue == Generated]-          generated `shouldSatisfy` (not . null)-          forM_ generated $ \moduleValue -> do-            let recognized = filter isGeneratedBannerLine (T.lines ((.text) moduleValue))-                expected = generatedBannerFor (checkedLanguageContract service) ((.origin) moduleValue)-            recognized `shouldBe` [expected]-            expected-              `shouldSatisfy` T.isInfixOf-                ( "keiro-dsl "-                    <> T.pack (showVersion Package.version)-                    <> " (language keiro-dsl 4) from contract emergency"-                )-      workspace <- shouldComposeWorkspace canonicalWorkspacePath-      workspacePlan <- shouldPlanWorkspaceSpec workspace-      forM_ [moduleValue | (moduleValue, _) <- (.modules) workspacePlan, (.kind) moduleValue == Generated] $ \moduleValue ->-        filter isGeneratedBannerLine (T.lines ((.text) moduleValue))-          `shouldBe` [generatedBannerFor (checkedLanguageContract (checkedWorkspace workspace)) ((.origin) moduleValue)]-    it "recognizes only the historical banner and the stamped format" $ do-      let contract = effectiveLanguageContract LegacyUnversioned-      isGeneratedBannerLine generatedBanner `shouldBe` True-      isGeneratedBannerLine (generatedBannerFor contract "aggregate Counter (line 2)") `shouldBe` True-      isGeneratedBannerLine "-- @generated by another tool" `shouldBe` False-      isGeneratedBannerLine codecComparisonBanner `shouldBe` False-    it "migrates a legacy-banner file and keeps repeated scaffold bytes stable" $-      withTempDirectory "keiro-dsl-stamped-banner" $ \out -> do-        spec <- parseInlineSpec "<stamped-banner>" loweringAggregateSpec-        let ctx = defaultContext (spec.context)-        modules <- case planTestScaffold ctx spec of-          Left refusals -> expectationFailure (show refusals) >> pure []-          Right planned -> pure planned-        case [moduleValue | moduleValue <- modules, (.kind) moduleValue == Generated] of-          target : _ -> do-            let path = out </> target.path-                stamped = generatedBannerFor (effectiveLanguageContract LegacyUnversioned) ((.origin) target)-                legacyText = T.replace stamped generatedBanner ((.text) target)-            createDirectoryIfMissing True (takeDirectory path)-            TIO.writeFile path legacyText-            first <- executeScaffold out False "counter.keiro" ctx spec modules-            first `shouldSatisfy` isSuccessfulScaffold-            firstTree <- treeSnapshot out-            second <- executeScaffold out False "counter.keiro" ctx spec modules-            second `shouldSatisfy` isSuccessfulScaffold-            treeSnapshot out `shouldReturn` firstTree-            TIO.readFile path `shouldReturn` (.text) target-          [] -> expectationFailure "counter scaffold has no Generated module"--  describe "service-aware fixture helpers" $ do-    it "retains version-4 contract TypeIDs and their durable admission identities" $ do-      service <- checkedServiceOf "test/fixtures/contract-v4.keiro"-      modules <- scaffoldFixture "test/fixtures/contract-v4.keiro"-      let contractModule = generatedTextEndingIn "Contract.hs" modules-          identities = idDomainIdentitiesForService service-      contractModule `shouldSatisfy` T.isInfixOf "incidentId :: !(KindID \"inc\")"-      contractModule `shouldSatisfy` T.isInfixOf "reservationId :: !(KindID \"rsv\")"-      identities-        `shouldContain` ["id-domain|name=contract:emergency.IncidentTransferNeedDeclared.incidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text"]--  describe "scaffold gates" $ do-    it "reports case-folded generated paths through the complete check diagnostics" $ do-      spec <- specOf "test/fixtures/reservation.keiro"-      case [aggregate | NAggregate aggregate <- (.nodes) spec] of-        aggregate : _ -> do-          let caseVariant =-                specWithNodes-                  [ NAggregate aggregate,-                    NAggregate (aggregateWithName (T.toUpper aggregate.name) aggregate)-                  ]-                  spec-              diagnostics =-                checkTestServiceDiagnostics-                  Nothing-                  (defaultContext (caseVariant.context))-                  (legacyCheckedService caseVariant)-          map (.code) diagnostics `shouldContain` [GeneratedPathCollision]-          case [ diagnostic-               | diagnostic <- diagnostics,-                 (.code) diagnostic == GeneratedPathCollision,-                 "Domain.hs" `T.isInfixOf` (.message) diagnostic-               ] of-            [diagnostic] -> do-              (.line) diagnostic `shouldBe` unLoc ((.loc) aggregate)-              (.relatedLocations) diagnostic `shouldSatisfy` (not . null)-              (.message) diagnostic `shouldSatisfy` T.isInfixOf "case-insensitive filesystem"-            found -> expectationFailure ("expected one generated-path diagnostic, got " <> show found)-          withTempDirectory "keiro-dsl-check-path-collision" $ \root -> do-            let sourcePath = root </> "collision.keiro"-            version <- maybe (expectationFailure "language version 4 missing" >> fail "unreachable") pure (languageVersion 4)-            TIO.writeFile sourcePath (renderSource (ParsedSource (DeclaredLanguage version noLoc) caseVariant))-            (exitCode, out, err) <- runKeiroDsl ["check", sourcePath]-            exitCode `shouldBe` ExitFailure 1-            out `shouldBe` ""-            err `shouldContain` "error[GeneratedPathCollision]"-        [] -> expectationFailure "reservation fixture has no aggregate"-    it "uses lowering before module planning in both scaffold planners" $ do-      spec <- specOf "test/fixtures/emit.keiro"-      case [contract | NContract contract <- (.nodes) spec] of-        contract : _ -> do-          let defective =-                mapPublisher-                  (publisherWithBackoff (BackoffSpec "exponential" "2s" Nothing Nothing))-                  (specWithNodes (NContract contract : spec.nodes) spec)-              ctx = defaultContext (defective.context)-              workspace = oneMemberWorkspace "emit.keiro" defective-          case (planTestScaffold ctx defective, planWorkspaceScaffold "goldens" ctx workspace) of-            (Left (LoweringRefusal singleReasons : _), Left (LoweringRefusal workspaceReasons : _)) ->-              workspaceReasons `shouldBe` singleReasons-            results -> expectationFailure ("expected lowering first from both planners, got " <> show results)-        [] -> expectationFailure "emit fixture has no contract"-    it "maps import cycles and planner invariants into stable check codes" $ do-      planningRefusalDiagnostics [ImportCycle ["A", "B", "A"]]-        `shouldSatisfy` any ((== GeneratedImportCycle) . (.code))-      planningRefusalDiagnostics [BehaviorRefusal [Behavior.DuplicateBehaviorIdentity "duplicate" [Loc 9]]]-        `shouldSatisfy` any (\diagnostic -> (.code) diagnostic == BehaviorDerivationInvalid && (.line) diagnostic == 9)-      planningRefusalDiagnostics [DuplicateConformanceFactKeys [DuplicateServiceFactKey "duplicate"]]-        `shouldSatisfy` any ((== ConformanceFactKeyCollision) . (.code))-      planningRefusalDiagnostics [SemanticContractMismatch "test mismatch"]-        `shouldSatisfy` any ((== GeneratedPlanningInvariantViolation) . (.code))-      spec <- specOf "test/fixtures/consumer-types.keiro"-      let cyclic = spec {mapped = map moveArtifactBindingIntoGenerated ((.mapped) spec)}-      checkTestServiceDiagnostics Nothing (defaultContext (cyclic.context)) (stableCheckedService cyclic)-        `shouldSatisfy` any ((== GeneratedImportCycle) . (.code))-    it "refuses duplicate and case-folded module paths with both origins" $ do-      spec <- specOf "test/fixtures/reservation.keiro"-      case [aggregate | NAggregate aggregate <- (.nodes) spec] of-        aggregate : _ -> do-          let duplicate = specWithNodes [NAggregate aggregate, NAggregate aggregate] spec-              caseVariant = specWithNodes [NAggregate aggregate, NAggregate (aggregateWithName (T.toUpper aggregate.name) aggregate)] spec-          planTestScaffold (defaultContext (spec.context)) duplicate `shouldSatisfy` hasPathCollisionWithTwoOrigins-          planTestScaffold (defaultContext (spec.context)) caseVariant `shouldSatisfy` hasPathCollisionWithTwoOrigins-        [] -> expectationFailure "reservation fixture has no aggregate"-    it "refuses a bannerless Generated target without changing its bytes" $-      withTempDirectory "keiro-dsl-banner" $ \out -> do-        spec <- specOf "test/fixtures/reservation.keiro"-        let ctx = defaultContext (spec.context)-        case planTestScaffold ctx spec of-          Left refusals -> expectationFailure ("unexpected planning refusal: " <> show refusals)-          Right modules -> case [m | m <- modules, (.kind) m == Generated] of-            generated : _ -> do-              let target = out </> (.path) generated-              createDirectoryIfMissing True (takeDirectory target)-              TIO.writeFile target "hand owned\n"-              result <- executeScaffold out False "test/fixtures/reservation.keiro" ctx spec modules-              result `shouldSatisfy` isMissingBannerRefusal-              TIO.readFile target `shouldReturn` "hand owned\n"-              forced <- executeScaffold out True "test/fixtures/reservation.keiro" ctx spec modules-              forced `shouldSatisfy` isSuccessfulScaffold-              TIO.readFile target `shouldReturn` (.text) generated-            [] -> expectationFailure "reservation scaffold has no Generated module"-    it "reports renamed-node modules as stale without deleting them" $-      withTempDirectory "keiro-dsl-stale-rename" $ \out -> do-        spec <- parseInlineSpec "<stale-rename>" loweringAggregateSpec-        first <- executePlannedScaffold out "counter.keiro" (defaultContext (spec.context)) spec-        let renamed = specWithNodes (map renameCounter spec.nodes) spec-        second <- executePlannedScaffold out "counter.keiro" (defaultContext (renamed.context)) renamed-        let oldDomain = onlyPathEndingIn "Counter/Domain.hs" (map fst ((.dispositions) first))-            oldHoles = onlyPathEndingIn "Counter/Holes.hs" (map fst ((.dispositions) first))-        (.stale) second `shouldSatisfy` \stale ->-          StaleModule Generated oldDomain (Just ExactGeneratedBannerPresent) `elem` stale-            && StaleModule HoleStub oldHoles Nothing `elem` stale-        doesFileExist (out </> oldDomain) `shouldReturn` True-        doesFileExist (out </> oldHoles) `shouldReturn` True-        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "exact generated banner present; verify unchanged bytes before deleting")-        renderScaffoldReport second `shouldSatisfy` all (not . T.isInfixOf "safe to delete")-    it "preserves a stale generated path whose exact banner is missing" $-      withTempDirectory "keiro-dsl-stale-banner" $ \out -> do-        spec <- parseInlineSpec "<stale-banner>" loweringAggregateSpec-        first <- executePlannedScaffold out "counter.keiro" (defaultContext (spec.context)) spec-        let oldDomain = onlyPathEndingIn "Counter/Domain.hs" (map fst ((.dispositions) first))-            renamed = specWithNodes (map renameCounter spec.nodes) spec-        TIO.writeFile (out </> oldDomain) "-- generated by something else\n"-        second <- executePlannedScaffold out "counter.keiro" (defaultContext (renamed.context)) renamed-        (.stale) second `shouldSatisfy` elem (StaleModule Generated oldDomain (Just ExactGeneratedBannerMissing))-        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "exact generated banner missing; preserve and review")-        TIO.readFile (out </> oldDomain) `shouldReturn` "-- generated by something else\n"-    it "reports the entire old tree across a module-root flip" $-      withTempDirectory "keiro-dsl-stale-root" $ \out -> do-        spec <- parseInlineSpec "<stale-root>" loweringAggregateSpec-        let initialCtx = defaultContext (spec.context)-            rootedCtx = contextWithModuleRoot "Acme" initialCtx-        first <- executePlannedScaffold out "counter.keiro" initialCtx spec-        second <- executePlannedScaffold out "moved-counter.keiro" rootedCtx spec-        (.stale) second-          `shouldMatchList` [ StaleModule ((.kind) m) ((.path) m) (if (.kind) m == Generated then Just ExactGeneratedBannerPresent else Nothing)-                            | (m, _) <- (.dispositions) first-                            ]-        forM_ ((.stale) second) $ \stale -> doesFileExist (out </> (.path) stale) `shouldReturn` True-        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "previous scaffold record used spec counter.keiro")-    it "reports moved generated modules across a layout flip" $-      withTempDirectory "keiro-dsl-stale-layout" $ \out -> do-        spec <- parseInlineSpec "<stale-layout>" loweringAggregateSpec-        let initialCtx = defaultContext (spec.context)-            collocatedCtx = initialCtx {placement = CollocatedLeaf}-        first <- executePlannedScaffold out "counter.keiro" initialCtx spec-        second <- executePlannedScaffold out "counter.keiro" collocatedCtx spec-        let oldGenerated = [StaleModule Generated ((.path) m) (Just ExactGeneratedBannerPresent) | (m, _) <- (.dispositions) first, (.kind) m == Generated]-        (.stale) second `shouldSatisfy` all (`elem` oldGenerated)-        length ((.stale) second) `shouldBe` length oldGenerated-    it "writes a parseable record and no stale section for a fresh output" $-      withTempDirectory "keiro-dsl-record" $ \out -> do-        spec <- parseInlineSpec "<fresh-record>" loweringAggregateSpec-        let ctx = defaultContext (spec.context)-        report <- executePlannedScaffold out "counter.keiro" ctx spec-        (.stale) report `shouldBe` []-        renderScaffoldReport report `shouldSatisfy` all (not . T.isPrefixOf "stale:")-        contents <- TIO.readFile (out </> recordFileName (spec.context))-        requirements <- either (\errors -> expectationFailure (show errors) >> pure []) pure (Behavior.deriveBehaviorRequirements spec)-        let expected =-              ScaffoldRecord-                { specPath = "counter.keiro",-                  moduleRoot = "",-                  layout = "prefixed",-                  sourceLanguage = LegacyUnversioned,-                  languageContract = effectiveLanguageContract LegacyUnversioned,-                  namingEdition = IdiomaticNamingV2,-                  moduleRoles = [ScaffoldModuleRoleRow (moduleRole m) ((.kind) m) ((.path) m) | (m, _) <- (.dispositions) report],-                  files = [((.kind) m, (.path) m) | (m, _) <- (.dispositions) report],-                  mappings = [],-                  idDomains = [],-                  nominalEqualities = [],-                  bindingObligations = [],-                  behaviorRequirements = Behavior.behaviorRecordRows requirements,-                  projectionCatalogFacts = [],-                  queryContractBaseline = False,-                  queryContracts = either (const []) id (queryContractIdentities spec),-                  routerSelections = [],-                  semanticImpact = Just (semanticImpactSnapshotForSpec spec)-                }-            sourceRows = filter ("source-language " `T.isPrefixOf`) (T.lines contents)-            withoutSourceRows = T.unlines (filter (not . T.isPrefixOf "source-language ") (T.lines contents))-            semanticRows = filter ("semantic-contract " `T.isPrefixOf`) (T.lines contents)-            withoutSemanticRows = T.unlines (filter (not . T.isPrefixOf "semantic-contract ") (T.lines contents))-        parseRecord contents `shouldBe` Just expected-        contents `shouldNotSatisfy` T.isInfixOf "query-contract-baseline"-        parseRecord withoutSourceRows `shouldBe` Just expected-        parseRecord withoutSemanticRows `shouldBe` Just expected-        case sourceRows of-          [sourceRow] -> do-            parseRecord (T.replace sourceRow (sourceRow <> "\n" <> sourceRow) contents) `shouldBe` Nothing-            parseRecord (T.replace sourceRow "source-language {malformed}" contents) `shouldBe` Nothing-          _ -> expectationFailure "expected exactly one source-language row"-        case semanticRows of-          [semanticRow] -> do-            parseRecord (T.replace semanticRow (semanticRow <> "\n" <> semanticRow) contents) `shouldBe` Nothing-            parseRecord (T.replace semanticRow "semantic-contract {malformed}" contents) `shouldBe` Nothing-            parseRecord (T.replace "\"languageVersion\":1" "\"languageVersion\":2" contents) `shouldBe` Nothing-          _ -> expectationFailure "expected exactly one semantic-contract row"-        parseRecord (T.replace "spec: " "future-field: retained\nspec: " contents) `shouldBe` parseRecord contents-        parseRecord (T.replace "record v1" "record v2" contents) `shouldBe` Nothing-    it "records declared provenance and reports a header-only scaffold drift" $-      withTempDirectory "keiro-dsl-language-drift" $ \out -> do-        spec <- parseInlineSpec "<language-drift>" loweringAggregateSpec-        let ctx = defaultContext (spec.context)-        modules <- case planTestScaffold ctx spec of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right planned -> pure planned-        _ <- executePlannedScaffold out "counter.keiro" ctx spec-        case languageVersion 1 of-          Nothing -> expectationFailure "version 1 was not constructible"-          Just version -> do-            let declared = DeclaredLanguage version noLoc-            result <- executeScaffoldWithLanguage out False "counter.keiro" declared ctx spec modules-            case result of-              Left refusals -> expectationFailure (show refusals)-              Right report -> do-                (.sourceLanguageDrift) report-                  `shouldBe` Just (SourceLanguageDrift LegacyUnversioned declared)-                contents <- TIO.readFile ((.recordPath) report)-                (.sourceLanguage) <$> parseRecord contents `shouldBe` Just declared--  describe "faithful scaffold lowering" $ do-    it "escapes a trailing-backslash payload literal exactly once" $ do-      spec <- specOf "test/fixtures/hospital-surge.keiro"-      case [process | NProcess process <- (.nodes) spec] of-        process : _ -> do-          let timer = timerNodeWithPayload [FieldBinding "kind" (Just "\"follow-up\\\"")] process.timer-              modules = scaffoldProcess (defaultContext (spec.context)) process {timer = timer}-          generatedTextEndingIn "Process.hs" modules-            `shouldSatisfy` T.isInfixOf "\"kind\" .= (\"follow-up\\\\\" :: Value)"-        [] -> expectationFailure "hospital-surge fixture has no process"-    it "preserves quoted Text register initials and refuses unsafe register shapes" $ do-      spec <- parseInlineSpec "<register-initials>" loweringAggregateSpec-      let modules = scaffoldAggregate (defaultContext (spec.context)) spec =<< [aggregate | NAggregate aggregate <- (.nodes) spec]-          domain = generatedTextEndingIn "Domain.hs" modules-      domain `shouldSatisfy` T.isInfixOf "RCons (Proxy @\"note\") \"hello world\""-      scaffoldRefusals spec `shouldBe` []-      bare <- parseInlineSpec "<bare-text-initial>" (T.replace "\"hello world\"" "hello" loweringAggregateSpec)-      scaffoldRefusals bare `shouldSatisfy` any (T.isInfixOf "RegTextInitialNotQuoted")-      unsupported <- parseInlineSpec "<unsupported-field>" (T.replace "count:Int" "count:Json" loweringAggregateSpec)-      scaffoldRefusals unsupported `shouldSatisfy` any (T.isInfixOf "FieldTypeUnrepresentable")-    it "lowers seconds, minutes, hours, and both backoff constructors faithfully" $ do-      windowSeconds "90s" `shouldBe` Right 90-      windowSeconds "5m" `shouldBe` Right 300-      windowSeconds "2h" `shouldBe` Right 7200-      emitSource <- readTestText "test/fixtures/emit.keiro"-      let exponentialSource = T.replace "backoff constant 2s" "backoff exponential 2s max=60s multiplier=2.0" emitSource-      exponential <- parseInlineSpec "<exponential-backoff>" exponentialSource-      case [publisher | NPublisher publisher <- (.nodes) exponential] of-        publisher : _ -> do-          let generated = generatedTextEndingIn "Publisher.hs" (scaffoldPublisher (defaultContext (exponential.context)) publisher)-          generated `shouldSatisfy` T.isInfixOf "ExponentialBackoff ExponentialBackoffOptions { initial = 2, maxDelay = 60, multiplier = 2.0 }"-          parseSpec "<exponential-round-trip>" (renderSpec exponential) `shouldBe` Right exponential-        [] -> expectationFailure "emit fixture has no publisher"-      constant <- parseInlineSpec "<constant-backoff>" (T.replace "backoff constant 2s" "backoff constant 2m" emitSource)-      case [publisher | NPublisher publisher <- (.nodes) constant] of-        publisher : _ -> generatedTextEndingIn "Publisher.hs" (scaffoldPublisher (defaultContext (constant.context)) publisher) `shouldSatisfy` T.isInfixOf "ConstantBackoff 120"-        [] -> expectationFailure "emit fixture has no publisher"-    it "refuses incomplete exponential backoff and rejects unknown window units" $ do-      emitSource <- readTestText "test/fixtures/emit.keiro"-      incomplete <- parseInlineSpec "<incomplete-backoff>" (T.replace "backoff constant 2s" "backoff exponential 2s" emitSource)-      scaffoldRefusals incomplete `shouldSatisfy` any (T.isInfixOf "BackoffExponentialIncomplete")-      parseSpec "<bad-window>" (T.replace "backoff constant 2s" "backoff constant 2x" emitSource)-        `shouldSatisfy` leftContains "time unit: s, m, or h"-    it "lowers workqueue retry windows in minutes to seconds" $ do-      queueSource <- readTestText "test/fixtures/reservation-work.keiro"-      queueSpec <- parseInlineSpec "<minute-queue>" (T.replace "5s" "5m" queueSource)-      case [workqueue | NWorkqueue workqueue <- (.nodes) queueSpec] of-        workqueue : _ -> do-          let policy = generatedTextEndingIn "QueuePolicy.hs" (scaffoldWorkqueue (defaultContext (queueSpec.context)) workqueue)-          policy `shouldSatisfy` T.isInfixOf "defaultRetryDelay = RetryDelay 300"-          policy `shouldSatisfy` T.isInfixOf "Retry (RetryDelay 300)"-        [] -> expectationFailure "queue fixture has no workqueue"-    it "uses exact status-map keys and emits total Int harness samples" $ do-      statusSpec <- parseInlineSpec "<exact-status>" exactStatusSpec-      case [aggregate | NAggregate aggregate <- (.nodes) statusSpec] of-        aggregate : _ -> do-          let ctx = defaultContext (statusSpec.context)-              projection = generatedTextEndingIn "Projection.hs" (scaffoldAggregate ctx statusSpec aggregate)-              harness = generatedTextEndingIn "Harness.hs" (harnessFor ctx statusSpec aggregate)-          projection `shouldSatisfy` T.isInfixOf "ReservationUnHeld {} -> Just \"available\""-          harness `shouldSatisfy` T.isInfixOf "CountBumpedData 0"-          harness `shouldNotSatisfy` T.isInfixOf "sample: unsupported"-        [] -> expectationFailure "exact-status spec has no aggregate"--  describe "scaffold" $ do-    it "keeps field DSL names, generated selectors, and wire keys independent" $ do-      source <- readTestText "test/fixtures/aggregate-field-alias.keiro"-      document <- case parseSourceDocument "aggregate-field-alias.keiro" source of-        Left failure -> expectationFailure (show failure) >> fail "unreachable"-        Right value -> pure value-      let ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = document-          service = checkedSource parsedSource-          spec = checkedSpec service-          ctx = defaultContext (spec.context)-          modules = scaffoldServiceModules ctx service-          domain = generatedTextEndingIn "Domain.hs" modules-          codec = generatedTextEndingIn "Codec.hs" modules-      workspace <--        either-          (\failure -> expectationFailure (show failure) >> fail "unreachable")-          pure-          (oneMemberParsedDocumentWorkspace "aggregate-field-alias.keiro" document)-      validateService service `shouldBe` []-      domain `shouldSatisfy` ((== 2) . T.count "payloadType :: !Text")-      domain `shouldSatisfy` ((== 2) . T.count "serviceRegion :: !Text")-      domain `shouldSatisfy` ((== 2) . T.count "family :: !Text")-      codec `shouldSatisfy` T.isInfixOf "\"type\" .= payload.payloadType"-      codec `shouldSatisfy` T.isInfixOf "\"region_code\" .= payload.serviceRegion"-      codec `shouldSatisfy` T.isInfixOf "o .: \"region_code\""-      scaffoldServiceModules ctx service `shouldBe` modules-      fmap (map fst . (.modules)) (planWorkspaceScaffold "goldens" ctx workspace)-        `shouldBe` planIndexedServiceScaffold sourceIndex ctx service--      newSpec <- parseInlineSpec "aggregate-field-alias-v2.keiro" (T.replace "event FieldsCopied =" "event FieldsCopied v2 =" source)-      case goldensForDiff spec newSpec of-        [golden] -> do-          (.json) golden `shouldSatisfy` T.isInfixOf "\"family\":\"sample\""-          (.json) golden `shouldSatisfy` T.isInfixOf "\"type\":\"sample\""-          (.json) golden `shouldSatisfy` T.isInfixOf "\"region_code\":\"sample\""-          (.json) golden `shouldSatisfy` (not . T.isInfixOf "payloadType")-          (.json) golden `shouldSatisfy` (not . T.isInfixOf "serviceRegion")-        goldens -> expectationFailure ("expected one field-alias golden, got " <> show goldens)--    it "keeps aggregate fold identity neutral across field aliases" $ do-      let sourceFor field =-            T.unlines-              [ "language keiro-dsl 4",-                "context field-alias-neutrality",-                "aggregate AliasNeutrality",-                "  regs",-                "  states Open",-                "  command Observe { " <> field <> " }",-                "  event Observed = fields(Observe)",-                "  wire kind=ctorName fields=camelCase schemaVersion=1"-              ]-      base <- checkedServiceFromText "field-alias-base.keiro" (sourceFor "region:Text")-      selectorAlias <- checkedServiceFromText "field-alias-selector.keiro" (sourceFor "region haskell serviceRegion:Text")-      wireAlias <- checkedServiceFromText "field-alias-wire.keiro" (sourceFor "region as \"region_code\":Text")-      let fingerprint service = aggregateFoldFingerprintForService service (onlyAggregate (checkedSpec service))-          codecFor service =-            generatedTextEndingIn-              "Codec.hs"-              (scaffoldServiceModules (defaultContext ((checkedSpec service).context)) service)-      fingerprint selectorAlias `shouldBe` fingerprint base-      fingerprint wireAlias `shouldBe` fingerprint base-      codecFor base `shouldSatisfy` T.isInfixOf "\"region\" .= payload.region"-      codecFor selectorAlias `shouldSatisfy` T.isInfixOf "\"region\" .= payload.serviceRegion"-      codecFor selectorAlias `shouldSatisfy` (not . T.isInfixOf "region_code")-      codecFor wireAlias `shouldSatisfy` T.isInfixOf "\"region_code\" .= payload.region"--    it "synthesizes the exact old wire shape and embeds it in the harness" $ do-      oldSpec <- specOf "test/fixtures/reservation.keiro"-      newSpec <- specOf "test/fixtures/reservation-v2.keiro"-      case goldensForDiff oldSpec newSpec of-        [golden] -> do-          goldenRelativePath golden-            `shouldBe` "hospital-capacity/Reservation/TransferReservationCreated.v1.json"-          (.json) golden-            `shouldBe` "{\"commandId\":\"cmd_01hzy3v7q2e8kaw2m5x0d41n9c\",\"divertStatus\":\"open\",\"hospitalId\":\"hosp_01hzy3v7q2e8kaw2m5x0d41n9c\",\"kind\":\"TransferReservationCreated\",\"lifeCriticalOverride\":true,\"patientAcuity\":\"red\",\"reservationId\":\"rsv_01hzy3v7q2e8kaw2m5x0d41n9c\"}\n"-          (.evidence) golden `shouldBe` SynthesizedWeakStandIn-          let aggregate = onlyAggregate newSpec-              modules =-                harnessForWithGoldens-                  [golden]-                  (defaultContext (newSpec.context))-                  newSpec-                  aggregate-              harness = generatedTextEndingIn "Harness.hs" modules-          harness `shouldSatisfy` T.isInfixOf "golden TransferReservationCreated.v1 decodes"-          harness `shouldSatisfy` T.isInfixOf "\\\"reservationId\\\":\\\"rsv_"-          harness `shouldSatisfy` (not . T.isInfixOf "current-shape stand-in")-        goldens -> expectationFailure ("expected one synthesized golden, got " <> show goldens)-    it "synthesizes complete nested mapped old shapes deterministically and never overwrites captured evidence" $ do-      oldSpec <- specOf "test/fixtures/consumer-types.keiro"-      newSpec <- specOf "test/fixtures/consumer-types-v2.keiro"-      case goldensForDiff oldSpec newSpec of-        [golden] -> do-          (.evidence) golden `shouldBe` SynthesizedWeakStandIn-          (.json) golden `shouldSatisfy` T.isInfixOf "\"artifact\":{"-          (.json) golden `shouldSatisfy` T.isInfixOf "\"location\":{\"contents\":\"sample\",\"tag\":\"local_file\"}"-          (.json) golden `shouldSatisfy` T.isInfixOf "\"labels\":[\"sample\"]"-          (.json) golden `shouldSatisfy` T.isInfixOf "\"revision\":1"-          (.json) golden `shouldSatisfy` T.isInfixOf "\"observedAt\":\"2026-01-01T00:00:00Z\""-          goldensForDiff oldSpec newSpec `shouldBe` [golden]-          withTempDirectory "keiro-golden-preserve" $ \root -> do-            let target = root </> goldenRelativePath golden-            createDirectoryIfMissing True (takeDirectory target)-            TIO.writeFile target "hand captured\n"-            emitGoldenPayloads root oldSpec newSpec `shouldReturn` []-            TIO.readFile target `shouldReturn` "hand captured\n"-          withTempDirectory "keiro-golden-write" $ \root -> do-            let target = root </> goldenRelativePath golden-            emitGoldenPayloads root oldSpec newSpec `shouldReturn` [target]-            TIO.readFile target `shouldReturn` (.json) golden-        goldens -> expectationFailure ("expected one nested synthesized golden, got " <> show goldens)-    it "dispatches shared-version upcasters by wire event type and passes foreign kinds through" $ do-      parsed <- parsedSourceOf "test/fixtures/reservation-dup-upcast-source.keiro"-      let spec = parsed.spec-      case [aggregate | NAggregate aggregate <- (.nodes) spec] of-        [_] -> do-          let modules = scaffoldServiceModules (defaultContext (spec.context)) (checkedSource parsed)-              codec = generatedTextEndingIn "Codec.hs" modules-              holes = case [(.text) m | m <- modules, "/Holes.hs" `T.isSuffixOf` T.pack ((.path) m)] of-                [text] -> text-                _ -> ""-          codec `shouldSatisfy` T.isInfixOf "upcasters = [(1, upcastRungV1)]"-          codec `shouldSatisfy` T.isInfixOf "upcastRungV1 (EventType \"TransferReservationCreated\") value = upcastTransferReservationCreatedV1 value"-          codec `shouldSatisfy` T.isInfixOf "upcastRungV1 (EventType \"TransferReservationConfirmed\") value = upcastTransferReservationConfirmedV1 value"-          codec `shouldSatisfy` T.isInfixOf "upcastRungV1 _ value = Right value"-          holes `shouldSatisfy` T.isInfixOf "receives ONLY TransferReservationCreated payloads"-        _ -> expectationFailure "expected exactly one aggregate"-    it "keeps foreign payloads byte-for-byte and invokes both same-rung event upcasters" $ do-      let payloadA = object ["kind" .= ("AmountScaled" :: T.Text), "amount" .= (2 :: Int)]-          payloadB = object ["kind" .= ("AmountRenamed" :: T.Text), "amount" .= (3 :: Int)]-          foreignPayload = object ["kind" .= ("AmountObserved" :: T.Text), "amount" .= (7 :: Int)]-          upcastA _ = Right (object ["kind" .= ("AmountScaled" :: T.Text), "amount" .= (200 :: Int)])-          upcastB _ = Right (object ["kind" .= ("AmountRenamed" :: T.Text), "amountInCents" .= (300 :: Int)])-          rung (EventType "AmountScaled") = upcastA-          rung (EventType "AmountRenamed") = upcastB-          rung _ = Right-          codec =-            Codec-              { eventTypes = EventType "AmountScaled" :| [EventType "AmountRenamed", EventType "AmountObserved"],-                eventType = const (EventType "AmountObserved"),-                schemaVersion = 2,-                encode = id,-                decode = \_ -> Right,-                upcasters = [(1, rung)]-              } ::-              Codec Value-      decodeRaw codec (EventType "AmountObserved") 1 foreignPayload `shouldBe` Right foreignPayload-      decodeRaw codec (EventType "AmountScaled") 1 payloadA-        `shouldBe` Right (object ["kind" .= ("AmountScaled" :: T.Text), "amount" .= (200 :: Int)])-      decodeRaw codec (EventType "AmountRenamed") 1 payloadB-        `shouldBe` Right (object ["kind" .= ("AmountRenamed" :: T.Text), "amountInCents" .= (300 :: Int)])-    it "never emits a keiki symbolic operator into a Generated module (firewall)" $ do-      mods <- scaffoldFixture "test/fixtures/reservation.keiro"-      firewallBreaches mods `shouldBe` []-    it "marks the Holes module HoleStub and the rest Generated" $ do-      mods <- scaffoldFixture "test/fixtures/reservation.keiro"-      let holes = [m | m <- mods, (.kind) m == HoleStub]-      map (takeFileName . (.path)) holes `shouldBe` ["BehaviorHoles.hs", "Holes.hs"]-      -- Context nominals/internal/replay plus the stable aggregate surface.-      length [m | m <- mods, (.kind) m == Generated] `shouldBe` 10-    it "is deterministic (re-scaffolding yields byte-identical text)" $ do-      a <- scaffoldFixture "test/fixtures/reservation.keiro"-      b <- scaffoldFixture "test/fixtures/reservation.keiro"-      map (.text) a `shouldBe` map (.text) b-    it "keeps retiring as validator-only metadata in generated modules" $ do-      ordinary <- scaffoldFixture "test/fixtures/reservation.keiro"-      retiring <- scaffoldFixture "test/fixtures/reservation-retiring.keiro"-      map (\m -> ((.path) m, (.kind) m, (.text) m)) retiring-        `shouldBe` map (\m -> ((.path) m, (.kind) m, (.text) m)) ordinary-    it "matches the committed compiling Generated conformance modules (modulo whitespace)" $ do-      mods <- scaffoldFixture "test/fixtures/reservation.keiro"-      mapM_ assertMatchesCommitted [m | m <- mods, (.kind) m == Generated]-    it "matches every committed new-surface Generated module (modulo formatting)" $ do-      modules <- scaffoldFixture "test/fixtures/transfer-routing.keiro"-      forM_ [m | m <- modules, (.kind) m == Generated] $ \m -> do-        committed <- readTestText ("test/conformance-newsurface/" <> (.path) m)-        normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) m)-    it "scaffolds the register-free OrderStream smoke target without error" $ do-      mods <- scaffoldFixture "test/fixtures/order.keiro"-      -- Stable and.aggregate.modules.context plus both hand-owned hole surfaces.-      length mods `shouldBe` 12-      firewallBreaches mods `shouldBe` []-      let harness = generatedTextEndingIn "Harness.hs" mods-      harness `shouldSatisfy` T.isInfixOf "prefix = \"forward/replay equality: PlaceOrder from OrderNotStarted -- \""-      harness `shouldSatisfy` T.isInfixOf "prefix <> \"final vertex\""-      harness `shouldNotSatisfy` T.isInfixOf "prefix <> \"register "-    it "emits forward/replay checks with field-distinct Text samples" $ do-      spec <- parseInlineSpec "<forward-replay-samples>" (T.replace "command Bump { count:Int }" "command Bump { count:Int noteText:Text echo:Text }" loweringAggregateSpec)-      case [aggregate | NAggregate aggregate <- (.nodes) spec] of-        aggregate : _ -> do-          let ctx = defaultContext (spec.context)-              harness = generatedTextEndingIn "Harness.hs" (harnessFor ctx spec aggregate)-          harness `shouldSatisfy` T.isInfixOf "\"sample-noteText\" \"sample-echo\""-          harness `shouldSatisfy` T.isInfixOf "prefix = \"forward/replay equality: Bump from CounterPending -- \""-          harness `shouldSatisfy` T.isInfixOf "prefix <> \"register note\""-        [] -> expectationFailure "forward/replay sample spec has no aggregate"-    it "keeps inequality-guard samples distinct from register initials" $ do-      mods <- scaffoldFixture "test/fixtures/subscription.keiro"-      let harness = generatedTextEndingIn "Harness.hs" mods-      harness `shouldSatisfy` T.isInfixOf "ActivateSubscriptionData"-      harness `shouldSatisfy` T.isInfixOf "Paid"-      harness `shouldNotSatisfy` T.isInfixOf "ActivateSubscriptionData (case parseSubscriptionId \"sub_01h455vb4pex5vsknk084sn02q\" of Right parsed -> parsed; Left _ -> error \"generated valid ID sample failed to parse\") (case parseCustomerId \"cust_01h455vb4pex5vsknk084sn02q\" of Right parsed -> parsed; Left _ -> error \"generated valid ID sample failed to parse\") Free"-    it "uses consumer-owned nominal initials for equality-guard samples" $ do-      mods <- scaffoldFixture "test/fixtures/nominal-scalars.keiro"-      let harness = generatedTextEndingIn "Harness.hs" mods-      harness `shouldSatisfy` T.isInfixOf "Bindings.initialOrderId"-      harness `shouldSatisfy` (not . T.isInfixOf "NominalConformance.Bindings.initialOrderId")-      harness `shouldNotSatisfy` T.isInfixOf "case parseOrderId"-    it "emits the canonical reservation register checks" $ do-      mods <- scaffoldFixture "test/fixtures/reservation.keiro"-      let harness = generatedTextEndingIn "Harness.hs" mods-      harness `shouldSatisfy` T.isInfixOf "prefix = \"forward/replay equality: RequestTransferReservation from ReservationUnrequested -- \""-      harness `shouldSatisfy` T.isInfixOf "prefix <> \"register reservationId\""-      harness `shouldSatisfy` T.isInfixOf "prefix <> \"register hospitalId\""-      harness `shouldSatisfy` T.isInfixOf "prefix <> \"register patientAcuity\""-      harness `shouldNotSatisfy` T.isInfixOf "prefix <> \"register reservationState\""-    it "lowers a replay-only transition to B.replayOnly in the holes skeleton (plan 143)" $ do-      twinMods <- scaffoldFixture "test/fixtures/reservation-guard-tightened-twin.keiro"-      map (.text) twinMods `shouldSatisfy` any (T.isInfixOf "B.replayOnly")-      let twinHarness = generatedTextEndingIn "Harness.hs" twinMods-      T.count "forwardReplayRequestTransferReservation ::" twinHarness `shouldBe` 1-      plainMods <- scaffoldFixture "test/fixtures/reservation.keiro"-      map (.text) plainMods `shouldSatisfy` all (not . T.isInfixOf "B.replayOnly")--  describe "service workspace (EP-153)" $ do-    describe "manifest grammar" $ do-      it "round-trips the canonical fixture manifest byte-for-byte" $ do-        source <- readTestText canonicalWorkspacePath-        manifest <- shouldParseManifest canonicalWorkspacePath source-        (.service) manifest `shouldBe` "demo-project"-        (.runtimePackage) manifest `shouldBe` Nothing-        (.moduleRoot) manifest `shouldBe` Just "Demo.Modules.Project"-        (.layout) manifest `shouldBe` Just CollocatedLeaf-        map (.path) (NE.toList ((.members) manifest))-          `shouldBe` [ "domain/project-artifact.keiro",-                       "domain/project.keiro",-                       "domain/shared.keiro"-                     ]-        renderWorkspaceManifest manifest-          `shouldBe` T.intercalate-            "\n"-            [ "service demo-project",-              "module Demo.Modules.Project",-              "layout collocated",-              "spec domain/project-artifact.keiro",-              "spec domain/project.keiro",-              "spec domain/shared.keiro"-            ]-      it "round-trips runtime-package canonically immediately after service" $ do-        manifest <--          shouldParseManifest "<runtime-package>" $-            T.unlines-              [ "service mori",-                "module Mori.Modules",-                "spec domain/mori.keiro",-                "runtime-package mori-core",-                "layout collocated"-              ]-        (.runtimePackage) manifest `shouldBe` Just (RuntimePackageName "mori-core")-        effectiveRuntimePackage Nothing manifest `shouldBe` Just (RuntimePackageName "mori-core")-        effectiveRuntimePackage (Just (RuntimePackageName "mori-dev")) manifest-          `shouldBe` Just (RuntimePackageName "mori-dev")-        renderWorkspaceManifest manifest-          `shouldBe` T.intercalate-            "\n"-            [ "service mori",-              "runtime-package mori-core",-              "module Mori.Modules",-              "layout collocated",-              "spec domain/mori.keiro"-            ]-      it "validates runtime package names with the mapped-source Cabal grammar" $ do-        mkRuntimePackageName "mori-core" `shouldBe` Right (RuntimePackageName "mori-core")-        mkRuntimePackageName "mori_core" `shouldBe` Left "runtime package 'mori_core' does not follow Cabal package-name grammar"-      it "treats membership as a set: source order changes neither the AST nor the bytes" $ do-        canonical <- readTestText canonicalWorkspacePath >>= shouldParseManifest canonicalWorkspacePath-        reordered <--          shouldParseManifest "<reordered>" $-            T.unlines-              [ "service demo-project",-                "layout collocated",-                "spec domain/shared.keiro",-                "module Demo.Modules.Project",-                "spec domain/project.keiro",-                "spec ./domain/project-artifact.keiro"-              ]-        reordered `shouldBe` canonical-        renderWorkspaceManifest reordered `shouldBe` renderWorkspaceManifest canonical-      it "satisfies parse . render == id and render . parse . render == render" $-        property $-          forAll genWorkspaceManifest $ \manifest ->-            let rendered = renderWorkspaceManifest manifest-             in case parseWorkspaceManifest "<generated>" rendered of-                  Left err -> counterexample (T.unpack err) False-                  Right reparsed ->-                    counterexample (T.unpack rendered) $-                      reparsed == manifest && renderWorkspaceManifest reparsed == rendered-      it "recognizes a workspace manifest by extension, case-insensitively" $ do-        map-          isWorkspacePath-          [ "service.keiro-workspace",-            "a/b/Service.KEIRO-Workspace",-            "service.keiro",-            ".keiro-workspace",-            "keiro-workspace"-          ]-          `shouldBe` [True, True, False, False, False]-    describe "manifest refusals" $ do-      let rejects description source expected =-            it description $ case parseWorkspaceManifest "<manifest>" source of-              Right _ -> expectationFailure ("expected a refusal, got a manifest for:\n" <> T.unpack source)-              Left err -> T.unpack err `shouldContain` expected-      rejects-        "an empty manifest"-        "# only a comment\n"-        "must begin with a 'service <name>' clause"-      rejects-        "a manifest with no service clause"-        "spec domain/a.keiro\n"-        "first clause of a workspace manifest must be 'service <name>'"-      rejects-        "a manifest whose first clause is not service"-        "module Demo\nservice demo\nspec domain/a.keiro\n"-        "first clause of a workspace manifest must be 'service <name>'"-      rejects-        "a duplicate service clause"-        "service demo\nservice demo\nspec domain/a.keiro\n"-        "duplicate 'service' clause"-      rejects-        "a duplicate module clause"-        "service demo\nmodule Demo\nmodule Demo\nspec domain/a.keiro\n"-        "duplicate 'module' clause"-      rejects-        "a duplicate runtime-package clause"-        "service demo\nruntime-package demo-core\nruntime-package demo-api\nspec domain/a.keiro\n"-        "duplicate 'runtime-package' clause"-      it "locates a malformed runtime-package at its manifest line" $ case parseWorkspaceManifest "<manifest>" "service demo\nspec domain/a.keiro\nruntime-package demo_core\n" of-        Right _ -> expectationFailure "expected a malformed runtime package refusal"-        Left err -> do-          T.unpack err `shouldContain` "<manifest>:3:1"-          T.unpack err `shouldContain` "does not follow Cabal package-name grammar"-      rejects-        "a duplicate layout clause"-        "service demo\nlayout prefixed\nlayout prefixed\nspec domain/a.keiro\n"-        "duplicate 'layout' clause"-      rejects-        "a manifest with no members"-        "service demo\nmodule Demo\n"-        "must list at least one 'spec <path>.keiro' member"-      rejects-        "the same member listed twice"-        "service demo\nspec domain/a.keiro\nspec ./domain/a.keiro\n"-        "duplicate workspace member 'domain/a.keiro'"-      rejects-        "two members that differ only by case"-        "service demo\nspec domain/a.keiro\nspec domain/A.keiro\n"-        "differ only by case"-      rejects-        "an absolute member path"-        "service demo\nspec /etc/a.keiro\n"-        "must be relative, not absolute"-      rejects-        "a member path escaping the manifest directory"-        "service demo\nspec ../escape.keiro\n"-        "must not contain '..' segments"-      rejects-        "a member that is not a .keiro spec"-        "service demo\nspec domain/a.txt\n"-        "must name a .keiro spec"-      rejects-        "a manifest listing another manifest"-        "service demo\nspec domain/other.keiro-workspace\n"-        "must name a .keiro spec"-    describe "line relocation" $ do-      it "shifts every location the AST carries, and only the locations" $ do-        spec <- specOf "test/fixtures/reservation.keiro"-        let shifted = relocateLocs (+ 1000) spec-        collectLocs spec `shouldSatisfy` (not . null)-        collectLocs shifted `shouldBe` map (+ 1000) (collectLocs spec)-        -- Loc's Eq deliberately ignores the line, so relocation cannot-        -- change any equality-based behavior anywhere downstream.-        shifted `shouldBe` spec-      it "leaves the placeholder location alone so it never lands inside a member range" $ do-        spec <- specOf "test/fixtures/reservation.keiro"-        let blanked = relocateLocs (const 0) spec-            reshifted = relocateLocs (\n -> if n <= 0 then n else n + 500) blanked-        collectLocs reshifted `shouldBe` map (const 0) (collectLocs spec)-    describe "composition" $ do-      it "resolves cross-file ids, enums, mapped types, and read-model feeds" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        (.service) workspace `shouldBe` "demo-project"-        workspace.context `shouldBe` "demo-project"-        (.moduleRoot) workspace `shouldBe` Just "Demo.Modules.Project"-        (.layout) workspace `shouldBe` Just CollocatedLeaf-        map (.path) ((.members) workspace)-          `shouldBe` [ "domain/project-artifact.keiro",-                       "domain/project.keiro",-                       "domain/shared.keiro"-                     ]-        -- Every member is individually incomplete; together they check.-        checkWorkspace workspace `shouldBe` []-      it "records which member owns each shared declaration and node" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        let ownershipIndex = workspace.ownership-        fmap fst (declarationOwner ownershipIndex "id" "ProjectId")-          `shouldBe` Just "domain/shared.keiro"-        fmap fst (declarationOwner ownershipIndex "enum" "ProjectPhase")-          `shouldBe` Just "domain/shared.keiro"-        fmap fst (declarationOwner ownershipIndex "rule" "phaseIsTerminal")-          `shouldBe` Just "domain/shared.keiro"-        fmap fst (declarationOwner ownershipIndex "mapped" "ProjectSummary")-          `shouldBe` Just "domain/shared.keiro"-        fmap fst (nodeOwner ownershipIndex "aggregate" "Project")-          `shouldBe` Just "domain/project.keiro"-        fmap fst (nodeOwner ownershipIndex "aggregate" "ProjectArtifact")-          `shouldBe` Just "domain/project-artifact.keiro"-        fmap fst (nodeOwner ownershipIndex "readmodel" "project_activity")-          `shouldBe` Just "domain/project-artifact.keiro"-      it "maps every merged line back to the member that wrote it" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        let bases = [((.path) m, (.lineBase) m, (.lineCount) m) | m <- (.members) workspace]-        -- Ranges are disjoint and contiguous from zero.-        map (\(_, base, _) -> base) bases `shouldBe` scanl (+) 0 (init [c | (_, _, c) <- bases])-        sequence_-          [ resolveWorkspaceLine workspace (base + offset) `shouldBe` Just (path, offset)-          | (path, base, memberLines) <- bases,-            offset <- [1, memberLines]-          ]-        resolveWorkspaceLine workspace 0 `shouldBe` Nothing-      it "is insensitive to the order members are listed in" $ do-        canonical <- shouldComposeWorkspace canonicalWorkspacePath-        reordered <- shouldComposeWorkspace reorderedWorkspacePath-        workspaceWithManifestPath canonical.manifestPath reordered `shouldBe` canonical-      describe "workspace source provenance" $ do-        it "keeps a later member's exact points stable when an earlier member gains source lines" $ do-          let manifestText = T.unlines ["service provenance", "spec a.keiro", "spec b.keiro"]-              aSource =-                T.unlines-                  [ "context provenance",-                    "aggregate Alpha",-                    "  regs",-                    "  states Empty",-                    "  command Ping {}",-                    "  event Pinged {}",-                    "  Empty -- Ping --> emit Pinged; goto Empty"-                  ]-              bSource =-                T.unlines-                  [ "context provenance",-                    "aggregate Beta",-                    "  regs",-                    "  states Empty",-                    "  command Ping {}",-                    "  event Pinged {}",-                    "  Empty -- Ping --> emit Pinged; goto Empty"-                  ]-              sourceWith alpha =-                ContentSource-                  { csRead = \case-                      "service.keiro-workspace" -> pure (Right manifestText)-                      "a.keiro" -> pure (Right alpha)-                      "b.keiro" -> pure (Right bSource)-                      path -> pure (Left ("unexpected path " <> T.pack path))-                  }-              loadWith alpha = do-                loaded <- loadWorkspace (sourceWith alpha) "service.keiro-workspace"-                case loaded of-                  Left workspaceFailure -> expectationFailure (show workspaceFailure) >> fail "unreachable"-                  Right value -> pure value-              betaLocation workspace =-                lookupSourceSpan-                  (AggregateTransitionSubject "Beta" (TransitionOrdinal 0))-                  ((.sourceIndex) workspace)-              betaBase workspace = (.lineBase) <$> find ((== "b.keiro") . (.path)) ((.members) workspace)-          originalWorkspace <- loadWith aSource-          shiftedWorkspace <- loadWith ("# inserted before Alpha\n" <> aSource)-          betaLocation shiftedWorkspace `shouldBe` betaLocation originalWorkspace-          betaBase shiftedWorkspace `shouldBe` ((+ 1) <$> betaBase originalWorkspace)-          case betaLocation originalWorkspace of-            Just (ExactSourcePosition, SourceSpan {source, start = SourcePoint {line, column}}) ->-              (source, line, column) `shouldBe` ("b.keiro", 7, 3)-            other -> expectationFailure ("expected exact Beta transition location, got " <> show other)--          document <- case parseSourceDocument "b.keiro" bSource of-            Left parseFailure -> expectationFailure (show parseFailure) >> fail "unreachable"-            Right value -> pure value-          exactOneMember <- case oneMemberParsedDocumentWorkspace "b.keiro" document of-            Left sourceIndexFailure -> expectationFailure (show sourceIndexFailure) >> fail "unreachable"-            Right value -> pure value-          betaLocation exactOneMember `shouldBe` betaLocation originalWorkspace-          let ParsedSourceDocument {parsedSource} = document-              compatibility = oneMemberParsedWorkspace "b.keiro" parsedSource-          fmap fst (betaLocation compatibility) `shouldBe` Just CompatibilityLineOnly-      it "checks a single .keiro file as a one-member workspace, diagnostic for diagnostic" $ do-        let fixtures =-              [ "test/fixtures/reservation.keiro",-                "test/fixtures/consumer-types.keiro",-                "test/fixtures/aggregate-bad-refs.keiro",-                "test/fixtures/readmodel.keiro"-              ]-        forM_ fixtures $ \path -> do-          spec <- specOf path-          let workspace = oneMemberWorkspace path spec-              viaWorkspace = map (renderWorkspaceDiagnostic path) (checkWorkspace workspace)-              direct = map (renderDiagnostic path) (validateSpec spec)-          viaWorkspace `shouldBe` direct-        -- At least one of those fixtures must actually produce errors,-        -- or the equivalence claim is vacuous.-        badRefs <- specOf "test/fixtures/aggregate-bad-refs.keiro"-        checkWorkspace (oneMemberWorkspace "test/fixtures/aggregate-bad-refs.keiro" badRefs)-          `shouldSatisfy` any ((== Error) . (.severity))-    describe "composition refusals" $ do-      let refusesWith path expectedCode expectedFiles = do-            diagnostics <- shouldRefuseWorkspace path-            map (.code) (NE.toList diagnostics) `shouldContain` [expectedCode]-            let cited =-                  [ (.file) location-                  | diagnostic <- NE.toList diagnostics,-                    (.code) diagnostic == expectedCode,-                    location <- NE.toList ((.locations) diagnostic)-                  ]-            sort (nubOrd cited) `shouldBe` sort expectedFiles-      it "refuses members that declare different contexts, citing every context clause" $-        refusesWith-          "test/fixtures/workspace-context-mismatch/service.keiro-workspace"-          WorkspaceContextMismatch-          [WorkspaceMemberFile "domain/a.keiro", WorkspaceMemberFile "domain/b.keiro"]-      it "refuses a member layout clause that contradicts the manifest authority" $-        refusesWith-          "test/fixtures/workspace-authority-conflict/service.keiro-workspace"-          WorkspaceAuthorityConflict-          [WorkspaceManifestFile, WorkspaceMemberFile "domain/b.keiro"]-      it "refuses a textually identical shared declaration owned by two members" $-        refusesWith-          "test/fixtures/workspace-dup-decl/service.keiro-workspace"-          WorkspaceDuplicateDeclaration-          [WorkspaceMemberFile "domain/project.keiro", WorkspaceMemberFile "domain/shared.keiro"]-      it "refuses one aggregate defined in two members" $-        refusesWith-          "test/fixtures/workspace-dup-node/service.keiro-workspace"-          WorkspaceDuplicateNodeName-          [WorkspaceMemberFile "domain/a.keiro", WorkspaceMemberFile "domain/b.keiro"]-      it "refuses generated paths that collide across members under case folding" $-        refusesWith-          "test/fixtures/workspace-path-collision/service.keiro-workspace"-          WorkspacePathCollision-          [WorkspaceMemberFile "domain/a.keiro", WorkspaceMemberFile "domain/b.keiro"]-      it "reports a listed member that is missing from disk" $-        refusesWith-          "test/fixtures/workspace-missing-member/service.keiro-workspace"-          WorkspaceMemberUnreadable-          [WorkspaceManifestFile]-      it "reports a member that does not parse" $-        refusesWith-          "test/fixtures/workspace-member-parse-failed/service.keiro-workspace"-          WorkspaceMemberParseFailed-          [WorkspaceManifestFile]-      it "surfaces a cross-file unresolved reference through the merged validator" $ do-        workspace <- shouldComposeWorkspace "test/fixtures/workspace-unresolved/service.keiro-workspace"-        let errors = [d | d <- checkWorkspace workspace, (.severity) d == Error]-        map (.code) errors `shouldContain` [GuardAtomOutOfScope]-        [(.file) location | d <- errors, location <- NE.toList ((.locations) d)]-          `shouldContain` [WorkspaceMemberFile "domain/project.keiro"]-    describe "multi-file diagnostic rendering" $ do-      it "puts the primary location in the established shape and every other file on a note line" $ do-        diagnostics <- shouldRefuseWorkspace "test/fixtures/workspace-dup-decl/service.keiro-workspace"-        let manifest = "keiro-dsl/test/fixtures/workspace-dup-decl/service.keiro-workspace"-        map (renderWorkspaceDiagnostic manifest) (NE.toList diagnostics)-          `shouldBe` [ T.intercalate-                         "\n"-                         [ "keiro-dsl/test/fixtures/workspace-dup-decl/domain/project.keiro:4: error[WorkspaceDuplicateDeclaration]: duplicate declaration 'ProjectId': a shared declaration has exactly one owning member (identical duplicates do not merge)",-                           "  keiro-dsl/test/fixtures/workspace-dup-decl/domain/shared.keiro:4: note: also declared here, as id 'ProjectId'"-                         ]-                     ]-    describe "whole-service check through the CLI" $ do-      it "prints OK and exits zero for the composed fixture workspace" $ do-        (exitCode, out, err) <- runKeiroDsl ["check", canonicalWorkspacePath]-        unless (exitCode == ExitSuccess) (expectationFailure (out <> err))-        lines out `shouldBe` ["OK"]-      it "exits non-zero and names every involved file for a cross-file refusal" $ do-        (exitCode, _, err) <--          runKeiroDsl ["check", "test/fixtures/workspace-dup-decl/service.keiro-workspace"]-        exitCode `shouldBe` ExitFailure 1-        err `shouldContain` "error[WorkspaceDuplicateDeclaration]"-        err `shouldContain` "workspace-dup-decl/domain/project.keiro:4"-        err `shouldContain` "workspace-dup-decl/domain/shared.keiro:4"-      it "attributes a merged-graph validation error to the member that wrote it" $ do-        (exitCode, _, err) <--          runKeiroDsl ["check", "test/fixtures/workspace-unresolved/service.keiro-workspace"]-        exitCode `shouldBe` ExitFailure 1-        err `shouldContain` "workspace-unresolved/domain/project.keiro:12: error[GuardAtomOutOfScope]"-      it "produces byte-identical output for a manifest whose members are listed in reverse" $ do-        (canonicalCode, canonicalOut, _) <- runKeiroDsl ["check", canonicalWorkspacePath, "--emit"]-        (reorderedCode, reorderedOut, _) <- runKeiroDsl ["check", reorderedWorkspacePath, "--emit"]-        canonicalCode `shouldBe` ExitSuccess-        reorderedCode `shouldBe` ExitSuccess-        reorderedOut `shouldBe` canonicalOut-        (_, canonicalParse, _) <- runKeiroDsl ["parse", canonicalWorkspacePath]-        (_, reorderedParse, _) <- runKeiroDsl ["parse", reorderedWorkspacePath]-        reorderedParse `shouldBe` canonicalParse-      it "keeps the single-file path working, byte for byte" $ do-        (exitCode, out, err) <- runKeiroDsl ["check", "test/fixtures/reservation.keiro"]-        unless (exitCode == ExitSuccess) (expectationFailure (out <> err))-        lines out `shouldBe` ["OK"]-      it "explains bindings and reports coverage against the merged graph" $ do-        (bindingsCode, bindingsOut, _) <--          runKeiroDsl ["check", canonicalWorkspacePath, "--explain-bindings"]-        bindingsCode `shouldBe` ExitSuccess-        bindingsOut `shouldContain` "binding obligations for context demo-project"-        -- The obligation's use sites span both aggregate members, which-        -- is only possible because the graph was resolved once, merged.-        bindingsOut `shouldContain` "Project register summary : ProjectSummary"-        bindingsOut `shouldContain` "ProjectArtifact command RecordArtifact .artifactSummary : ProjectSummary"-        withTempDirectory "keiro-dsl-workspace-coverage" $ \out -> do-          let reportPath = out </> "coverage.json"-          (coverageCode, coverageOut, _) <--            runKeiroDsl ["check", canonicalWorkspacePath, "--coverage-report", reportPath]-          coverageCode `shouldBe` ExitSuccess-          coverageOut `shouldContain` "structural/opaque boundaries (reporting only)"-          report <- Aeson.eitherDecodeFileStrict reportPath-          case report of-            Left err -> expectationFailure err-            Right value -> coverageSpecPath value `shouldBe` Just (T.pack canonicalWorkspacePath)--  describe "workspace diff revision loading (EP-155 M1)" $ do-    it "composes added, removed, and renamed members through an in-memory content source" $ do-      project <- readTestText "test/fixtures/workspace/domain/project.keiro"-      artifact <- readTestText "test/fixtures/workspace/domain/project-artifact.keiro"-      shared <- readTestText "test/fixtures/workspace/domain/shared.keiro"-      let extra = "language keiro-dsl 4\ncontext demo-project\n\nid ExtraId prefix=extra\n"-          manifest members =-            T.unlines-              ( ["service demo-project", "module Demo.Modules.Project", "layout collocated"]-                  <> ["spec " <> T.pack member | member <- members]-              )-          baseFiles =-            Map.fromList-              [ ("domain/project.keiro", project),-                ("domain/project-artifact.keiro", artifact),-                ("domain/shared.keiro", shared)-              ]-          loadFrom members files =-            loadWorkspace-              (memoryContentSource (Map.insert "service.keiro-workspace" (manifest members) files))-              "service.keiro-workspace"-          baseMembers = ["domain/project.keiro", "domain/project-artifact.keiro", "domain/shared.keiro"]-          expectLoaded result = case result of-            Left failure -> expectationFailure (show failure) >> error "unreachable"-            Right workspace -> pure workspace--      oldAdded <- loadFrom baseMembers baseFiles >>= expectLoaded-      newAdded <--        loadFrom-          (baseMembers <> ["domain/extra.keiro"])-          (Map.insert "domain/extra.keiro" extra baseFiles)-          >>= expectLoaded-      map changeCode (diffSpecs ((.mergedSpec) oldAdded) ((.mergedSpec) newAdded))-        `shouldContain` [DeclarationAdded]--      oldRemoved <- loadFrom baseMembers baseFiles >>= expectLoaded-      newRemoved <--        loadFrom-          ["domain/project.keiro", "domain/shared.keiro"]-          (Map.delete "domain/project-artifact.keiro" baseFiles)-          >>= expectLoaded-      map changeCode (diffSpecs ((.mergedSpec) oldRemoved) ((.mergedSpec) newRemoved))-        `shouldContain` [EvtRemovedNotDeprecated]--      oldRenamed <- loadFrom baseMembers baseFiles >>= expectLoaded-      let renamedMembers = ["domain/project-renamed.keiro", "domain/project-artifact.keiro", "domain/shared.keiro"]-          renamedFiles = Map.insert "domain/project-renamed.keiro" project (Map.delete "domain/project.keiro" baseFiles)-      newRenamed <- loadFrom renamedMembers renamedFiles >>= expectLoaded-      diffSpecs ((.mergedSpec) oldRenamed) ((.mergedSpec) newRenamed) `shouldBe` []--  describe "workspace diff ownership and unified reports (EP-155 M2)" $ do-    it "classifies shared declarations at use sites across every member with owned citations" $ do-      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"-      new <- shouldComposeWorkspace "test/fixtures/workspace-diff-new/service.keiro-workspace"-      let changes = diffWorkspaces old new-          enumChanges = filter ((== EnumCtorAdded) . changeCode . (.change)) changes-          mappedChanges = filter ((== MappedFieldTypeChanged) . changeCode . (.change)) changes-          citedFiles workspaceChanges =-            [ (.file) site-            | change <- workspaceChanges,-              (_, Just site) <- (.useSites) change-            ]-      enumChanges `shouldSatisfy` (not . null)-      mappedChanges `shouldSatisfy` (not . null)-      let enumWireChanges =-            [ underlyingChange-            | workspaceChange <- enumChanges,-              let underlyingChange = workspaceChange.change,-              OldBinaryReadNewEvents `elem` breakingSurfaces underlyingChange-            ]-      enumWireChanges `shouldSatisfy` (not . null)-      enumWireChanges `shouldSatisfy` all (not . gatedBreaking defaultGate)-      enumWireChanges `shouldSatisfy` all (gatedBreaking (gateWith [OldBinaryReadNewEvents]))-      map (fmap (.file) . (.declarationSite)) (enumChanges <> mappedChanges)-        `shouldSatisfy` all (== Just "domain/shared.keiro")-      citedFiles enumChanges `shouldContain` ["domain/order.keiro", "domain/shipment.keiro"]-      citedFiles mappedChanges `shouldContain` ["domain/order.keiro", "domain/shipment.keiro"]-      let rendered = T.intercalate "\n" (map renderWorkspaceFinding (enumChanges <> mappedChanges))-      rendered `shouldSatisfy` T.isInfixOf "    declared: domain/shared.keiro:4"-      rendered `shouldSatisfy` T.isInfixOf "    use-site: Order"-      rendered `shouldSatisfy` T.isInfixOf "(domain/order.keiro:"-      rendered `shouldSatisfy` T.isInfixOf "(domain/shipment.keiro:"-      assertMatchesGolden "test/fixtures/workspace-diff-new/workspace.diff.golden" (T.unlines (map renderWorkspaceFinding changes))--    it "emits one additive version-1 report with workspace provenance" $ do-      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"-      new <- shouldComposeWorkspace "test/fixtures/workspace-diff-new/service.keiro-workspace"-      let changes = diffWorkspaces old new-          meta =-            WorkspaceMeta-              { identity = (.service) new,-                manifest = "service.keiro-workspace",-                since = "HEAD",-                membersOld = map (.path) ((.members) old),-                membersNew = map (.path) ((.members) new),-                adoptionBaseline = False-              }-      case Aeson.toJSON (workspaceDiffReport meta defaultGate changes) of-        Aeson.Object report -> do-          KeyMap.lookup "schema" report `shouldBe` Just (Aeson.String "keiro-dsl/diff-report/1")-          case KeyMap.lookup "workspace" report of-            Just (Aeson.Object workspace) -> do-              KeyMap.lookup "identity" workspace `shouldBe` Just (Aeson.String "workspace-diff")-              KeyMap.lookup "adoptionBaseline" workspace `shouldBe` Just (Aeson.Bool False)-            other -> expectationFailure ("missing workspace report metadata: " <> show other)-          case KeyMap.lookup "findings" report of-            Just (Aeson.Array findings) -> do-              findings `shouldSatisfy` (not . null)-              let objects = [finding | Aeson.Object finding <- toList findings]-              objects `shouldSatisfy` any (KeyMap.member "declaration")-              objects `shouldSatisfy` any (KeyMap.member "useSites")-            other -> expectationFailure ("missing workspace findings: " <> show other)-        other -> expectationFailure ("workspace report was not an object: " <> show other)--    it "computes one replay-impact value over both aggregates" $ do-      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"-      new <- shouldComposeWorkspace "test/fixtures/workspace-diff-new/service.keiro-workspace"-      case replayImpactSpecs ((.mergedSpec) old) ((.mergedSpec) new) of-        ReplayAffected affected -> Map.keysSet affected `shouldBe` Set.fromList ["Order", "Shipment"]-        ReplayNeutral -> expectationFailure "shared mapped evolution unexpectedly reported replay-neutral"--  describe "workspace ownership and authority changes (EP-155 M3)" $ do-    it "reports an unchanged aggregate move once without wire evolution" $ do-      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"-      moved <- shouldComposeWorkspace "test/fixtures/workspace-diff-moved/service.keiro-workspace"-      let changes = diffWorkspaces old moved-      map (changeCode . (.change)) changes `shouldBe` [OwnershipMoved]-      forM_ changes $ \workspaceMove -> do-        let move = (.change) workspaceMove-        move `shouldSatisfy` isAdvisory-        move `shouldSatisfy` (not . gatedBreaking defaultGate)-        move `shouldSatisfy` (not . gatedBreaking (gateWith [minBound .. maxBound]))-        deriveLabel defaultGate ((workspaceChangeKind move).vector) `shouldBe` LabelAdvisory-        remediationFor ((workspaceChangeKind move).context) OwnershipMoved-          `shouldBe` (RemedyRescaffoldWorkspace :| [])-        renderWorkspaceFinding workspaceMove-          `shouldSatisfy` T.isInfixOf "declaration moved domain/shipment.keiro -> domain/order.keiro"--    it "treats a member rename as the same owner-map change" $ do-      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"-      let ownershipIndex = old.ownership-          renamed =-            workspaceWithOwnership-              (OwnershipIndex ownershipIndex.declarations (Map.adjust (\(_, loc) -> ("domain/shipping.keiro", loc)) ("aggregate", "Shipment") ownershipIndex.nodes))-              old-          moves = filter ((== OwnershipMoved) . changeCode . (.change)) (diffWorkspaces old renamed)-      length moves `shouldBe` 1-      forM_ moves $ \move ->-        renderWorkspaceFinding move `shouldSatisfy` T.isInfixOf "domain/shipment.keiro -> domain/shipping.keiro"--    it "reports ownership motion beside an independently classified wire edit" $ do-      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"-      edited <- shouldComposeWorkspace "test/fixtures/workspace-diff-new/service.keiro-workspace"-      let ownershipIndex = edited.ownership-          movedAndEdited =-            workspaceWithOwnership-              (OwnershipIndex ownershipIndex.declarations (Map.adjust (\(_, loc) -> ("domain/order.keiro", loc)) ("aggregate", "Shipment") ownershipIndex.nodes))-              edited-          codes = map (changeCode . (.change)) (diffWorkspaces old movedAndEdited)-      codes `shouldContain` [OwnershipMoved]-      codes `shouldContain` [MappedFieldTypeChanged]--    it "reports context authority separately from derived read-model identity breaks" $ do-      old <- shouldComposeWorkspace canonicalWorkspacePath-      let newContext = "demo-project-renamed"-          renamed =-            workspaceWithContextAndMergedSpec newContext (specWithContext newContext old.mergedSpec) old-          changes = diffWorkspaces old renamed-          codes = map (changeCode . (.change)) changes-      codes `shouldContain` [WorkspaceAuthorityChanged]-      codes `shouldContain` [DerivedIdentityChanged]-      map (.change) changes `shouldSatisfy` any (gatedBreaking defaultGate)--    it "keeps service, module-root, and layout authority advisories non-blocking" $ do-      old <- shouldComposeWorkspace canonicalWorkspacePath-      let changed = workspaceWithAuthority "demo-project-renamed" (Just "Demo.Modules.Renamed") (Just GeneratedPrefix) old-          authority = filter ((== WorkspaceAuthorityChanged) . changeCode . (.change)) (diffWorkspaces old changed)-      length authority `shouldBe` 3-      forM_ (map (.change) authority) $ \change -> do-        deriveLabel defaultGate ((workspaceChangeKind change).vector) `shouldBe` LabelAdvisory-        change `shouldSatisfy` (not . gatedBreaking (gateWith [minBound .. maxBound]))-        remediationFor ((workspaceChangeKind change).context) WorkspaceAuthorityChanged-          `shouldBe` (RemedyRescaffoldWorkspace :| [RemedyRecompileConsumers])--  describe "workspace scaffold (EP-154)" $ do-    describe "workspace record" $ do-      it "round-trips modules, owners, members, mappings, obligations, and adoptions" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        let record = sampleWorkspaceRecord workspace-            rendered = renderWorkspaceRecord record-        parseWorkspaceRecord rendered `shouldBe` Just record-        -- The header pins the schema: a v1 context-keyed record and a-        -- workspace record can never be read as each other.-        T.lines rendered `shouldSatisfy` \case-          header : _ -> header == "keiro-dsl workspace scaffold record v1"-          [] -> False-        parseRecord rendered `shouldBe` Nothing-        parseWorkspaceRecord (T.replace "record v1" "record v2" rendered) `shouldBe` Nothing-      it "ignores unknown rows and unknown JSON keys, and keeps context-level rows ownerless" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        let record = sampleWorkspaceRecord workspace-            rendered = renderWorkspaceRecord record-        parseWorkspaceRecord (T.replace "service: " "future-row: retained\nservice: " rendered)-          `shouldBe` Just record-        parseWorkspaceRecord (T.replace "\"kind\":\"generated\"" "\"kind\":\"generated\",\"future\":1" rendered)-          `shouldBe` Just record-        [row | row <- (.modules) record, (.owner) row == Nothing]-          `shouldSatisfy` (not . null)-      it "rejects absent stable language rows and partial, duplicate, malformed, or inconsistent contracts" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        let record = sampleWorkspaceRecord workspace-            rendered = renderWorkspaceRecord record-            sourceRows = filter ("source-language " `T.isPrefixOf`) (T.lines rendered)-            withoutSourceRows = T.unlines (filter (not . T.isPrefixOf "source-language ") (T.lines rendered))-            semanticRows = filter ("semantic-contract " `T.isPrefixOf`) (T.lines rendered)-            withoutSemanticRows = T.unlines (filter (not . T.isPrefixOf "semantic-contract ") (T.lines rendered))-        parseWorkspaceRecord withoutSourceRows `shouldBe` Nothing-        case sourceRows of-          firstRow : secondRow : _ -> do-            parseWorkspaceRecord (T.unlines (filter (/= secondRow) (T.lines rendered))) `shouldBe` Nothing-            parseWorkspaceRecord (T.replace firstRow (firstRow <> "\n" <> firstRow) rendered) `shouldBe` Nothing-            parseWorkspaceRecord (T.replace firstRow "source-language {malformed}" rendered) `shouldBe` Nothing-          _ -> expectationFailure "expected multiple workspace source-language rows"-        parseWorkspaceRecord withoutSemanticRows `shouldBe` Just record-        case semanticRows of-          [semanticRow] -> do-            parseWorkspaceRecord (T.replace semanticRow (semanticRow <> "\n" <> semanticRow) rendered) `shouldBe` Nothing-            parseWorkspaceRecord (T.replace semanticRow "semantic-contract {malformed}" rendered) `shouldBe` Nothing-            parseWorkspaceRecord (T.replace "\"languageVersion\":4" "\"languageVersion\":3" rendered) `shouldBe` Nothing-          _ -> expectationFailure "expected one workspace semantic-contract row"-      it "rejects unsafe module, owner, member, and adoption paths" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        let rendered = renderWorkspaceRecord (sampleWorkspaceRecord workspace)-            corrupt from to = parseWorkspaceRecord (T.replace from to rendered)-        corrupt "member domain/shared.keiro" "member /etc/passwd" `shouldBe` Nothing-        corrupt "member domain/shared.keiro" "member ../escape.keiro" `shouldBe` Nothing-        corrupt "\"owner\":\"domain/shared.keiro\"" "\"owner\":\"../shared.keiro\"" `shouldBe` Nothing-        corrupt "\"path\":\"claimed/One.hs\"" "\"path\":\"/tmp/One.hs\"" `shouldBe` Nothing-      it "keys context and workspace history in structurally distinct explicit slots" $ do-        workspaceRecordFileName "demo-project"-          `shouldBe` workspaceLedgerFileName "demo-project"-        workspaceManifestFileName "demo-project"-          `shouldBe` workspaceCabalFragmentFileName "demo-project"-        workspaceRecordFileName "demo-project" `shouldNotBe` recordFileName "demo-project"-        contextLedgerFileName "workspace"-          `shouldNotBe` workspaceLedgerFileName "workspace"-        supersededByLine "demo-project"-          `shouldBe` "superseded-by: keiro-dsl-ledger.workspace.demo-project.txt"--    describe "workspace plan" $ do-      it "emits the context-level facade and replay-audit exactly once from the merged graph" $ do-        plan <- shouldPlanWorkspace canonicalWorkspacePath-        let modules = map fst (plan.modules)-            facades = [m | m <- modules, "StructuralProjections.hs" `isSuffixOfPath` m]-            audits = [m | m <- modules, "ReplayAudit.hs" `isSuffixOfPath` m]-            sourceMaps = [m | m <- modules, "BehaviorSourceMap.hs" `isSuffixOfPath` m]-            shapes = [m | m <- modules, "Structural/Shape/ProjectSummary.hs" `isSuffixOfPath` m]-        length facades `shouldBe` 1-        length audits `shouldBe` 1-        length sourceMaps `shouldBe` 1-        length shapes `shouldBe` 1-        -- The audit assembles aggregates owned by two different member-        -- files, which is only possible from one merged graph.-        forM_ audits $ \audit -> do-          (.text) audit `shouldSatisfy` T.isInfixOf "Project.projectEventStream"-          (.text) audit `shouldSatisfy` T.isInfixOf "ProjectArtifact.projectArtifactEventStream"-      it "gives every generated ID and enum one context owner and imports only aggregate uses" $ do-        plan <- shouldPlanWorkspace canonicalWorkspacePath-        let ctx = plan.context-            modules = map fst (plan.modules)-            nominalModules = [m | m <- modules, (.path) m == T.unpack (T.replace "." "/" (generatedNominalModule ctx) <> ".hs")]-            internalNominalModules = [m | m <- modules, (.path) m == T.unpack (T.replace "." "/" (generatedNominalModule ctx) <> "/Internal.hs")]-            domainFor suffix = case [m | m <- modules, suffix `isSuffixOfPath` m] of-              [m] -> pure m-              found -> expectationFailure ("expected one domain ending in " <> suffix <> ", got " <> show (map (.path) found)) >> fail "unreachable"-        ownerModule <- case nominalModules of-          [m] -> pure m-          found -> expectationFailure ("expected one generated nominal owner, got " <> show (map (.path) found)) >> fail "unreachable"-        internalOwnerModule <- case internalNominalModules of-          [m] -> pure m-          found -> expectationFailure ("expected one generated internal nominal owner, got " <> show (map (.path) found)) >> fail "unreachable"-        let nominalText = (.text) ownerModule-            internalNominalText = (.text) internalOwnerModule-        T.count "newtype ProjectId" nominalText `shouldBe` 0-        T.count "newtype ProjectId" internalNominalText `shouldBe` 1-        T.count "data ProjectPhase =" nominalText `shouldBe` 1-        T.count "data WorkspaceVisibility =" nominalText `shouldBe` 1-        projectDomain <- domainFor "Project/Generated/Domain.hs"-        artifactDomain <- domainFor "ProjectArtifact/Generated/Domain.hs"-        forM_ [projectDomain, artifactDomain] $ \domain -> do-          (.text) domain `shouldSatisfy` (not . T.isInfixOf "newtype ProjectId")-          (.text) domain `shouldSatisfy` (not . T.isInfixOf "data ProjectPhase")-          (.text) domain `shouldSatisfy` T.isInfixOf (generatedNominalModule ctx <> " (ProjectId, parseProjectId, ProjectPhase (..))")-          (.text) domain `shouldSatisfy` (not . T.isInfixOf "WorkspaceVisibility")-        -- Preserve the members' declared language contract. The active language-5-        -- candidate must not silently restamp an existing language-4 workspace.-        singleFileModules <- case planIndexedServiceScaffold ((.sourceIndex) ((.workspace) plan)) ctx (plan.checkedService) of-          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"-          Right values -> pure values-        let withoutOrigin m = ((.path) m, (.text) m, (.kind) m)-        map withoutOrigin singleFileModules `shouldBe` map withoutOrigin modules-        owners <- case planNominalGeneration ctx ((.mergedSpec) ((.workspace) plan)) of-          Left errors -> expectationFailure (show errors) >> fail "unreachable"-          Right values -> pure values-        map ((.name) . (.declaration)) owners-          `shouldBe` ["ProjectId", "ProjectPhase", "WorkspaceVisibility"]-        case [owner | owner <- owners, (.name) ((.declaration) owner) == "ProjectId"] of-          [owner] -> do-            (.moduleName) owner `shouldBe` generatedNominalModule ctx-            Set.fromList [NominalUseSite "Project" RegisterUse, NominalUseSite "ProjectArtifact" EventFieldUse]-              `shouldSatisfy` (`Set.isSubsetOf` (.useSites) owner)-          found -> expectationFailure ("expected one ProjectId owner, got " <> show (length found))-      it "attributes every module to its owning member and leaves shared ones context-level" $ do-        plan <- shouldPlanWorkspace canonicalWorkspacePath-        let memberPaths = map (.path) ((.members) ((.workspace) plan))-            ownerOf suffix =-              case [provenance | (m, provenance) <- (.modules) plan, suffix `isSuffixOfPath` m] of-                [provenance] -> Just provenance-                _ -> Nothing-        ownerOf "StructuralProjections.hs" `shouldBe` Just ContextLevel-        ownerOf "Generated/Nominals.hs" `shouldBe` Just ContextLevel-        ownerOf "ReplayAudit.hs" `shouldBe` Just ContextLevel-        ownerOf "Structural/Shape/ProjectSummary.hs"-          `shouldBe` Just (MemberOwned "domain/shared.keiro")-        ownerOf "Project/Generated/Domain.hs"-          `shouldBe` Just (MemberOwned "domain/project.keiro")-        ownerOf "ProjectArtifact/Generated/Domain.hs"-          `shouldBe` Just (MemberOwned "domain/project-artifact.keiro")-        ownerOf "ProjectActivity/Generated/ReadModel.hs"-          `shouldBe` Just (MemberOwned "domain/project-artifact.keiro")-        -- No module may claim an owner that is not a member of the-        -- workspace: the record's owner column has to stay resolvable.-        map (provenanceOwner . snd) ((.modules) plan)-          `shouldSatisfy` all (maybe True (`elem` memberPaths))-      it "keeps the compiled workspace nominal conformance tree byte-current" $ do-        workspace <- shouldComposeWorkspace "test/fixtures/workspace-nominals/service.keiro-workspace"-        plan <- shouldPlanWorkspaceSpec workspace-        let compiledPaths =-              [ "Generated/WorkspaceNominalProof/BehaviorSourceMap.hs",-                "Generated/WorkspaceNominalProof/Nominals.hs",-                "Generated/WorkspaceNominalProof/Project/Domain.hs",-                "Generated/WorkspaceNominalProof/Project/Codec.hs",-                "Generated/WorkspaceNominalProof/Project/Transducer.hs",-                "Generated/WorkspaceNominalProof/Project/BehaviorContract.hs",-                "Generated/WorkspaceNominalProof/Project/EventStream.hs",-                "Generated/WorkspaceNominalProof/Project/Harness.hs",-                "Generated/WorkspaceNominalProof/Project/Projection.hs",-                "Generated/WorkspaceNominalProof/ProjectArtifact/Domain.hs",-                "Generated/WorkspaceNominalProof/ProjectArtifact/Codec.hs",-                "Generated/WorkspaceNominalProof/ProjectArtifact/Transducer.hs",-                "Generated/WorkspaceNominalProof/ProjectArtifact/BehaviorContract.hs",-                "Generated/WorkspaceNominalProof/ProjectArtifact/EventStream.hs",-                "Generated/WorkspaceNominalProof/ProjectArtifact/Harness.hs",-                "Generated/WorkspaceNominalProof/ProjectArtifact/Projection.hs",-                "Generated/WorkspaceNominalProof/ReplayAudit.hs"-              ]-        map fst ((.modules) plan) `shouldSatisfy` all (not . isSuffixOfPath "/Holes.hs")-        forM_ compiledPaths $ \path ->-          case [m | (m, _) <- (.modules) plan, m.path == path] of-            [generated] -> do-              committed <- readTestText ("test/conformance-workspace-nominals/" <> path)-              normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) generated)-            found -> expectationFailure ("expected one generated module at " <> path <> ", got " <> show (map (.path) found))-      it "plans a one-member workspace byte-identically to the single-file path" $ do-        let fixtures =-              [ "test/fixtures/reservation.keiro",-                "test/fixtures/consumer-types.keiro",-                "test/fixtures/readmodel.keiro",-                "test/fixtures/hospital-surge.keiro"-              ]-        -- Modules and refusals both: hospital-surge refuses on both-        -- paths, which proves the gates agree as well as the emitters.-        forM_ fixtures $ \path -> do-          (workspace, document) <- exactOneMemberWorkspaceOf path-          let ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = document-              service = checkedSource parsedSource-              spec = checkedSpec service-              ctx = defaultContext (spec.context)-              isSourceMap moduleValue = "BehaviorSourceMap.hs" `isSuffixOfPath` moduleValue-          case (planWorkspaceScaffold "goldens" ctx workspace, planIndexedServiceScaffold sourceIndex ctx service) of-            (Left workspaceRefusals, Left singleSourceRefusals) ->-              workspaceRefusals `shouldBe` singleSourceRefusals-            (Right workspacePlan, Right singleSourceModules) -> do-              let workspaceModules = map fst ((.modules) workspacePlan)-                  workspaceStable = filter (not . isSourceMap) workspaceModules-                  singleSourceStable = filter (not . isSourceMap) singleSourceModules-                  workspaceSourceMaps = filter isSourceMap workspaceModules-                  singleSourceMaps = filter isSourceMap singleSourceModules-              workspaceStable `shouldBe` singleSourceStable-              case (workspaceSourceMaps, singleSourceMaps) of-                ([workspaceSourceMap], [singleSourceMap]) -> do-                  workspaceSourceMap.path `shouldBe` singleSourceMap.path-                  (.text) workspaceSourceMap-                    `shouldBe` T.replace (T.pack path) (T.pack (takeFileName path)) ((.text) singleSourceMap)-                found -> expectationFailure ("expected one source map per planning path, got " <> show (map (.path) (fst found), map (.path) (snd found)))-            (Left _, Right _) -> expectationFailure "workspace planning refused while single-source planning succeeded"-            (Right _, Left _) -> expectationFailure "workspace planning succeeded while single-source planning refused"-        -- The equality is not vacuous: at least one fixture plans, and-        -- its per-node modules are attributed to the single member.-        (workspace, document) <- exactOneMemberWorkspaceOf "test/fixtures/reservation.keiro"-        let ParsedSourceDocument {parsedSource = parsedSource} = document-            spec = checkedSpec (checkedSource parsedSource)-        case planWorkspaceScaffold "goldens" (defaultContext (spec.context)) workspace of-          Left refusals -> expectationFailure ("reservation should plan: " <> show refusals)-          Right plan -> do-            (.modules) plan `shouldSatisfy` (not . null)-            map snd ((.modules) plan)-              `shouldSatisfy` all (`elem` [ContextLevel, MemberOwned "reservation.keiro"])-            map snd ((.modules) plan)-              `shouldSatisfy` elem (MemberOwned "reservation.keiro")-      it "computes obligations from the complete merged graph, spanning members" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        case bindingObligations ((.mergedSpec) workspace) of-          Left graphErrors -> expectationFailure ("merged graph did not resolve: " <> show graphErrors)-          Right obligations ->-            case [o | o <- obligations, (.mappedName) o == "ProjectSummary", (.kind) o == BindingValue] of-              [obligation] -> do-                (.useSites) obligation-                  `shouldSatisfy` any (T.isInfixOf "Project register summary")-                (.useSites) obligation-                  `shouldSatisfy` any (T.isInfixOf "ProjectArtifact command RecordArtifact")-              found -> expectationFailure ("expected one ProjectSummary binding obligation, got " <> show (length found))-      it "refuses a case-folded path collision across members, naming both files" $ do-        workspace <- shouldComposeWorkspace canonicalWorkspacePath-        let collided = withCaseVariantAggregate workspace-        case planWorkspaceScaffold "goldens" (workspaceContext collided) collided of-          Right _ -> expectationFailure "expected a cross-member path collision refusal"-          Left refusals -> do-            let origins = concat [os | PathCollision _ os <- refusals]-            origins `shouldSatisfy` any (T.isInfixOf "domain/project.keiro: ")-            origins `shouldSatisfy` any (T.isInfixOf "domain/project-artifact.keiro: ")-      it "refuses golden fixtures stranded beside a member instead of under the workspace root" $-        withTempDirectory "keiro-dsl-workspace-goldens" $ \root -> do-          workspace <- writeGoldenWorkspace root-          let workspaceGoldens = root </> "golden-payloads"-              fixture = "hospital-capacity/Reservation/TransferReservationCreated.v1.json"-              beside = root </> "domain/golden-payloads" </> fixture-          goldenRootDivergence workspaceGoldens workspace `shouldReturn` []-          createDirectoryIfMissing True (takeDirectory beside)-          TIO.writeFile beside "{}\n"-          refusals <- goldenRootDivergence workspaceGoldens workspace-          refusals `shouldBe` [GoldenRootDivergence workspaceGoldens [beside]]-          renderRefusals refusals-            `shouldSatisfy` any (T.isInfixOf "one golden root per workspace")-          -- The same fixture under the workspace root is no divergence.-          let atRoot = workspaceGoldens </> fixture-          createDirectoryIfMissing True (takeDirectory atRoot)-          TIO.writeFile atRoot "{}\n"-          goldenRootDivergence workspaceGoldens workspace `shouldReturn` []--    describe "workspace scaffold" $ do-      it "writes workspace-keyed history and no context-keyed file at all" $-        withWorkspaceFixture "keiro-dsl-workspace-history" id $ \_ out workspace -> do-          report <- executePlannedWorkspaceScaffold out workspace-          (.recordPath) report-            `shouldBe` out </> workspaceLedgerFileName "demo-project"-          (.buildManifestPath) report-            `shouldBe` out </> workspaceCabalFragmentFileName "demo-project"-          doesFileExist (out </> recordFileName "demo-project") `shouldReturn` False-          doesFileExist (out </> contextCabalFragmentFileName "demo-project") `shouldReturn` False-          contents <- TIO.readFile ((.recordPath) report)-          buildManifest <- TIO.readFile ((.buildManifestPath) report)-          assertGeneratedHaskellContract "service.keiro-workspace" buildManifest-          case parseWorkspaceRecord contents of-            Nothing -> expectationFailure ("workspace record did not parse:\n" <> T.unpack contents)-            Just record -> do-              (.service) record `shouldBe` "demo-project"-              (.manifest) record `shouldBe` "service.keiro-workspace"-              (.queryContractBaseline) record `shouldBe` False-              contents `shouldNotSatisfy` T.isInfixOf "query-contract-baseline"-              (.members) record-                `shouldBe` [ "domain/project-artifact.keiro",-                             "domain/project.keiro",-                             "domain/shared.keiro"-                           ]-              -- Context-level modules are ownerless; everything-              -- else names the member that produced it.-              [(.path) row | row <- (.modules) record, (.owner) row == Nothing]-                `shouldSatisfy` \ownerless ->-                  length ownerless == 6-                    && any (T.isSuffixOf "StructuralConformance.hs" . T.pack) ownerless-                    && any (T.isSuffixOf "BehaviorSourceMap.hs" . T.pack) ownerless-                    && any (T.isSuffixOf "StructuralProjections.hs" . T.pack) ownerless-                    && any (T.isSuffixOf "Nominals.hs" . T.pack) ownerless-                    && any (T.isSuffixOf "Nominals/Internal.hs" . T.pack) ownerless-                    && any (T.isSuffixOf "ReplayAudit.hs" . T.pack) ownerless-              [ (.owner) row-                | row <- (.modules) record,-                  "Project/Generated/Domain.hs" `T.isSuffixOf` T.pack ((.path) row)-                ]-                `shouldBe` [Just "domain/project.keiro"]-      it "refuses and then applies old workspace sidecar names before reading history" $-        withWorkspaceFixture "keiro-dsl-workspace-sidecar-migration" id $ \_ out workspace -> do-          plan <- shouldPlanWorkspaceSpec workspace-          first <- executeWorkspaceScaffold out False plan-          either (\failure -> expectationFailure (show failure)) (const (pure ())) first-          let service = workspace.service-              currentLedger = workspaceLedgerFileName service-              currentFragment = workspaceCabalFragmentFileName service-              oldLedger = legacyWorkspaceRecordFileName service-              oldFragment = legacyWorkspaceManifestFileName service-          renameFile (out </> currentLedger) (out </> oldLedger)-          renameFile (out </> currentFragment) (out </> oldFragment)-          migrationTreeBefore <- treeSnapshot out-          refused <- executeWorkspaceScaffoldWithNameMigrations out False False plan-          refused `shouldSatisfy` \case-            Left [SidecarMigrationRequired moves] ->-              length moves == 2 && all ((== RenameSidecar) . (.moveDisposition)) moves-            _ -> False-          treeSnapshot out `shouldReturn` migrationTreeBefore-          applied <- executeWorkspaceScaffoldWithNameMigrations out False True plan-          report <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure applied-          map (.moveDisposition) ((.sidecarMoves) report) `shouldBe` [RenameSidecar, RenameSidecar]-          (.stale) report `shouldBe` []-          doesFileExist (out </> oldLedger) `shouldReturn` False-          doesFileExist (out </> oldFragment) `shouldReturn` False-          doesFileExist (out </> currentLedger) `shouldReturn` True-          doesFileExist (out </> currentFragment) `shouldReturn` True-          rerun <- executeWorkspaceScaffoldWithNameMigrations out False True plan-          either (\failure -> expectationFailure (show failure)) (\value -> (.sidecarMoves) value `shouldBe` []) rerun-      it "is idempotent: an unchanged second run rewrites nothing and reports nothing" $-        withWorkspaceFixture "keiro-dsl-workspace-idempotent" id $ \_ out workspace -> do-          first <- executePlannedWorkspaceScaffold out workspace-          treeBefore <- treeSnapshot out-          second <- executePlannedWorkspaceScaffold out workspace-          treeAfter <- treeSnapshot out-          treeAfter `shouldBe` treeBefore-          map thd3 ((.dispositions) second)-            `shouldSatisfy` all (`elem` [Unchanged, Skipped])-          (.stale) second `shouldBe` []-          (.ownershipMoves) second `shouldBe` []-          (.mappingDrift) second `shouldBe` []-          (.newHoles) second `shouldBe` []-          -- The first run had to write; the claim is not vacuous.-          map thd3 ((.dispositions) first) `shouldSatisfy` any (== Overwritten)-          renderWorkspaceScaffoldReport second-            `shouldSatisfy` all (not . T.isPrefixOf "stale:")-      it "isolates member-local source movement to the one context behavior source map" $-        withWorkspaceFixture "keiro-dsl-workspace-source-movement" id $ \root out workspace -> do-          _ <- executePlannedWorkspaceScaffold out workspace-          treeBefore <- treeSnapshot out-          let member = root </> "domain/project-artifact.keiro"-          original <- TIO.readFile member-          TIO.writeFile member ("# move exact positions without changing semantics\n\n" <> original)-          moved <- loadTempWorkspace root-          second <- executePlannedWorkspaceScaffold out moved-          let overwrittenPaths =-                [(.path) generatedModule | (generatedModule, _, Overwritten) <- (.dispositions) second]-          overwrittenPaths `shouldSatisfy` \case-            [path] -> T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack path)-            _ -> False-          (.declarations) (second.semanticImpact) `shouldBe` []-          map (.category) ((.generatedArtifactImpact) second)-            `shouldBe` [BehaviorSourceMapArtifact]-          treeAfter <- treeSnapshot out-          let isPositionBearingSidecar (path, _) =-                T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack path)-                  || takeFileName path == workspaceLedgerFileName "demo-project"-          filter (not . isPositionBearingSidecar) treeAfter-            `shouldBe` filter (not . isPositionBearingSidecar) treeBefore-      it "produces byte-identical output for members listed in reverse order" $-        withWorkspaceFixture "keiro-dsl-workspace-order-a" id $ \_ outA workspaceA ->-          withWorkspaceFixture "keiro-dsl-workspace-order-b" reverse $ \_ outB workspaceB -> do-            _ <- executePlannedWorkspaceScaffold outA workspaceA-            _ <- executePlannedWorkspaceScaffold outB workspaceB-            treeB <- treeSnapshot outB-            treeA <- treeSnapshot outA-            treeB `shouldBe` treeA-            map fst treeA `shouldSatisfy` elem (workspaceLedgerFileName "demo-project")-      it "reports stale files only for the member that changed" $-        withWorkspaceFixture "keiro-dsl-workspace-stale" id $ \root out workspace -> do-          first <- executePlannedWorkspaceScaffold out workspace-          let siblingPaths =-                [ (.path) m-                | (m, provenance, _) <- (.dispositions) first,-                  provenance == MemberOwned "domain/project-artifact.keiro"-                ]-          siblingsBefore <- traverse (TIO.readFile . (out </>)) siblingPaths-          renamed <- renameMemberAggregate root "domain/project.keiro" "Project" "Ledger"-          second <- executePlannedWorkspaceScaffold out renamed-          let stalePaths = map (.path) ((.stale) second)-          stalePaths `shouldSatisfy` (not . null)-          stalePaths `shouldSatisfy` all (T.isInfixOf "/Project/" . T.pack)-          -- Nothing the sibling member owns is stale, and nothing it-          -- owns changed on disk: no cross-member false positives.-          stalePaths `shouldSatisfy` all (`notElem` siblingPaths)-          siblingsAfter <- traverse (TIO.readFile . (out </>)) siblingPaths-          siblingsAfter `shouldBe` siblingsBefore-          forM_ stalePaths $ \path -> doesFileExist (out </> path) `shouldReturn` True-          (.stale) second-            `shouldSatisfy` all-              ( \stale -> case (.kind) stale of-                  Generated -> (.generatedEvidence) stale == Just ExactGeneratedBannerPresent-                  HoleStub -> (.generatedEvidence) stale == Nothing-              )-          renderWorkspaceScaffoldReport second-            `shouldSatisfy` any (T.isInfixOf "keiro-dsl never deletes files.")-          renderWorkspaceScaffoldReport second-            `shouldSatisfy` any (T.isInfixOf "exact generated banner present; verify unchanged bytes before deleting")-          renderWorkspaceScaffoldReport second-            `shouldSatisfy` all (not . T.isInfixOf "safe to delete")-      it "reports an aggregate moved between members as an ownership move, not stale churn" $-        withWorkspaceFixture "keiro-dsl-workspace-move" id $ \root out workspace -> do-          _ <- executePlannedWorkspaceScaffold out workspace-          treeBefore <- treeSnapshot out-          moved <- moveArtifactAggregate root-          second <- executePlannedWorkspaceScaffold out moved-          (.stale) second `shouldBe` []-          let moves = (.ownershipMoves) second-          moves `shouldSatisfy` (not . null)-          moves-            `shouldSatisfy` all-              ( \move ->-                  (.previous) move == Just "domain/project-artifact.keiro"-                    && (.current) move == Just "domain/project.keiro"-              )-          map (.path) moves-            `shouldSatisfy` any (T.isInfixOf "ProjectArtifact" . T.pack)-          -- Behavior contracts contain only semantic identity. Moving a-          -- declaration rewrites the one source.map.context, while the ledger-          -- independently records module ownership moves.-          map thd3 ((.dispositions) second)-            `shouldSatisfy` all (`elem` [Unchanged, Skipped, Overwritten])-          let overwrittenPaths =-                [(.path) generatedModule | (generatedModule, _, Overwritten) <- (.dispositions) second]-          overwrittenPaths `shouldSatisfy` \case-            [path] -> T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack path)-            _ -> False-          treeAfter <- treeSnapshot out-          map fst treeAfter `shouldBe` map fst treeBefore-          let unaffected (path, _) =-                path /= workspaceLedgerFileName "demo-project"-                  && path `notElem` overwrittenPaths-          filter unaffected treeAfter `shouldBe` filter unaffected treeBefore-          renderWorkspaceScaffoldReport second-            `shouldSatisfy` any (T.isInfixOf "changed owning member")-      it "leaves the tree, record, and manifest untouched when any member refuses" $-        withWorkspaceFixture "keiro-dsl-workspace-atomic" id $ \_ out workspace -> do-          _ <- executePlannedWorkspaceScaffold out workspace-          treeBefore <- treeSnapshot out-          let broken = withCaseVariantAggregate workspace-          case planWorkspaceScaffold "goldens" (workspaceContext broken) broken of-            Right _ -> expectationFailure "expected the broken workspace to refuse"-            Left refusals -> refusals `shouldSatisfy` any isPathCollision-          treeSnapshot out `shouldReturn` treeBefore-          -- A fresh output directory is never even created.-          withTempDirectory "keiro-dsl-workspace-atomic-fresh" $ \fresh -> do-            let target = fresh </> "out"-            case planWorkspaceScaffold "goldens" (workspaceContext broken) broken of-              Right _ -> expectationFailure "expected the broken workspace to refuse"-              Left _ -> doesDirectoryExist target `shouldReturn` False-      it "leaves prior workspace output byte-identical for parse, validation, and collision failures" $-        withWorkspaceFixture "keiro-dsl-workspace-atomic-cli" id $ \root out workspace -> do-          _ <- executePlannedWorkspaceScaffold out workspace-          treeBefore <- treeSnapshot out-          let member = root </> "domain/project-artifact.keiro"-              manifest = root </> "service.keiro-workspace"-          original <- TIO.readFile member-          let failures =-                [ ("parse", "context demo-project\naggregate !!!\n"),-                  ("validation", T.replace "ProjectId" "MissingProjectId" original),-                  ("collision", T.replace "aggregate ProjectArtifact" "aggregate PROJECT" original)-                ]-          forM_ failures $ \(failureKind, brokenSource) -> do-            TIO.writeFile member brokenSource-            (exitCode, stdoutText, stderrText) <--              runKeiroDsl ["scaffold", manifest, "--out", out]-            unless (exitCode == ExitFailure 1) $-              expectationFailure-                (failureKind <> " failure unexpectedly scaffolded:\n" <> stdoutText <> stderrText)-            treeSnapshot out `shouldReturn` treeBefore-            TIO.writeFile member original-      it "refuses the whole workspace for one bannerless Generated target, changing nothing" $-        withWorkspaceFixture "keiro-dsl-workspace-banner" id $ \_ out workspace -> do-          plan <- shouldPlanWorkspaceSpec workspace-          let generated = [m | (m, _) <- (.modules) plan, (.kind) m == Generated]-          case generated of-            [] -> expectationFailure "workspace fixture has no Generated module"-            target : _ -> do-              let path = out </> target.path-              createDirectoryIfMissing True (takeDirectory path)-              TIO.writeFile path "hand owned\n"-              treeBefore <- treeSnapshot out-              refused <- executeWorkspaceScaffold out False plan-              refused `shouldSatisfy` isMissingBannerRefusal-              treeSnapshot out `shouldReturn` treeBefore-              forced <- executeWorkspaceScaffold out True plan-              forced `shouldSatisfy` isSuccessfulScaffold-              TIO.readFile path `shouldReturn` (.text) target-      it "scaffolds a whole workspace through the CLI" $-        withTempDirectory "keiro-dsl-workspace-cli" $ \out -> do-          (exitCode, stdoutText, stderrText) <--            runKeiroDsl ["scaffold", canonicalWorkspacePath, "--out", out]-          unless (exitCode == ExitSuccess) (expectationFailure (stdoutText <> stderrText))-          stderrText `shouldContain` "workspace: demo-project"-          doesFileExist (out </> workspaceLedgerFileName "demo-project")-            `shouldReturn` True-          tree <- treeSnapshot out-          length [path | (path, _) <- tree, "StructuralProjections.hs" `T.isSuffixOf` T.pack path]-            `shouldBe` 1-          length [path | (path, _) <- tree, "ReplayAudit.hs" `T.isSuffixOf` T.pack path]-            `shouldBe` 1-          (secondCode, _, secondErr) <--            runKeiroDsl ["scaffold", canonicalWorkspacePath, "--out", out]-          secondCode `shouldBe` ExitSuccess-          secondErr `shouldSatisfy` (not . isInfixOfString "(overwritten)")-          treeSnapshot out `shouldReturn` tree-      it "accepts a validated runtime-package override and generates exactly one service package" $-        withTempDirectory "keiro-dsl-workspace-runtime-package-cli" $ \out -> do-          (exitCode, stdoutText, stderrText) <--            runKeiroDsl ["scaffold", canonicalWorkspacePath, "--out", out, "--runtime-package", "demo-runtime"]-          unless (exitCode == ExitSuccess) (expectationFailure (stdoutText <> stderrText))-          tree <- treeSnapshot out-          length [path | (path, _) <- tree, takeExtension path == ".cabal", "keiro-dsl-conformance.workspace.demo-project" `isInfixOfString` path]-            `shouldBe` 1-          stderrText `shouldSatisfy` isInfixOfString "conformance-target: cabal test keiro-demo-project-conformance"--    describe "workspace adoption" $ do-      it "replaces embedded 0.6 nominal declarations only in generated files" $-        withWorkspaceFixture "keiro-dsl-workspace-nominal-adopt" id $ \_ out workspace -> do-          plan <- shouldPlanWorkspaceSpec workspace-          let pathEndingIn suffix selectedKind =-                case [(.path) m | (m, _) <- (.modules) plan, (.kind) m == selectedKind, suffix `isSuffixOfPath` m] of-                  [path] -> pure path-                  found -> expectationFailure ("expected one path ending in " <> suffix <> ", got " <> show found) >> fail "unreachable"-          domainPath <- pathEndingIn "Project/Generated/Domain.hs" Generated-          nominalPath <- pathEndingIn "Generated/Nominals.hs" Generated-          internalNominalPath <- pathEndingIn "Generated/Nominals/Internal.hs" Generated-          path <- pathEndingIn "Project/Holes.hs" HoleStub-          writeFileWithParents-            (out </> domainPath)-            (generatedBanner <> "\n-- legacy 0.6 fixture\nmodule LegacyDomain where\nnewtype ProjectId = ProjectId String\ndata ProjectPhase = Draft | Active\n")-          writeFileWithParents (out </> path) "-- hand-owned 0.6 implementation\n"--          report <- executePlannedWorkspaceScaffold out workspace-          (.stale) report `shouldBe` []-          [disposition | (m, _, disposition) <- (.dispositions) report, m.path == domainPath]-            `shouldBe` [Overwritten]-          [disposition | (m, _, disposition) <- (.dispositions) report, m.path == nominalPath]-            `shouldBe` [Overwritten]-          newDomain <- TIO.readFile (out </> domainPath)-          newDomain `shouldSatisfy` (not . T.isInfixOf "newtype ProjectId")-          newDomain `shouldSatisfy` T.isInfixOf "Generated.Nominals (ProjectId, parseProjectId, ProjectPhase (..))"-          newNominals <- TIO.readFile (out </> nominalPath)-          T.count "newtype ProjectId" newNominals `shouldBe` 0-          T.count "data ProjectPhase =" newNominals `shouldBe` 1-          newInternalNominals <- TIO.readFile (out </> internalNominalPath)-          T.count "newtype ProjectId" newInternalNominals `shouldBe` 1-          TIO.readFile (out </> path) `shouldReturn` "-- hand-owned 0.6 implementation\n"-      it "adopts an overwritten same-context record pair by record and by banner" $-        withInlineWorkspace "keiro-dsl-workspace-adopt" adoptionMembers $ \_ out workspace -> do-          -- Reproduce today's defect first: two same-specs.context-          -- scaffolded independently into one directory, the second-          -- replacing the first's record and calling its files stale.-          specA <- parseInlineSpec "domain/a.keiro" adoptionMemberA-          specB <- parseInlineSpec "domain/b.keiro" adoptionMemberB-          let ctx = defaultContext "adoption-demo"-          legacyA <- executePlannedScaffold out "domain/a.keiro" ctx specA-          legacyB <- executePlannedScaffold out "domain/b.keiro" ctx specB-          (.stale) legacyB `shouldSatisfy` (not . null)-          legacyBefore <- TIO.readFile (out </> recordFileName "adoption-demo")--          report <- executePlannedWorkspaceScaffold out workspace-          (.stale) report `shouldBe` []-          case (.migration) report of-            Nothing -> expectationFailure "expected the first workspace run to adopt"-            Just migration -> do-              let generatedOf run = sort [(.path) m | (m, _) <- (.dispositions) run, (.kind) m == Generated]-                  claimedBy evidence = sort [entry.path | entry <- migration.claimed, entry.evidence == evidence]-              -- The surviving record attributes B's files; A's-              -- files survived only as banners, which is exactly-              -- the orphan case the overwrite created.-              claimedBy ClaimedFromRecord `shouldBe` generatedOf legacyB-              claimedBy ClaimedFromBanner `shouldBe` sort (generatedOf legacyA \\ generatedOf legacyB)-              claimedBy ClaimedFromBanner `shouldSatisfy` (not . null)-              (.likelyStale) migration `shouldBe` []-              (.legacyRecord) migration-                `shouldBe` Just (recordFileName "adoption-demo", "domain/b.keiro")-              -- Provenance is persisted, not merely printed.-              recorded <- parseWorkspaceRecord <$> TIO.readFile ((.recordPath) report)-              fmap (sort . map (.path) . (.adopted)) recorded-                `shouldBe` Just (sort (map (.path) ((.claimed) migration)))-              fmap (sort . nubOrd . map (.evidence) . (.adopted)) recorded-                `shouldBe` Just ["banner", "record"]-              persisted <- TIO.readFile (out </> "keiro-dsl-migration-report.workspace.adoption-demo.txt")-              persisted `shouldBe` T.unlines (renderMigrationReport migration)-              renderWorkspaceScaffoldReport report-                `shouldSatisfy` any (T.isInfixOf "adopting pre-workspace scaffold output")--          -- The legacy record gained one line and nothing else: it-          -- still parses to the same value for an old binary.-          legacyAfter <- TIO.readFile (out </> recordFileName "adoption-demo")-          T.lines legacyAfter `shouldSatisfy` elem (supersededByLine "adoption-demo")-          parseRecord legacyAfter `shouldBe` parseRecord legacyBefore-          T.lines legacyAfter-            `shouldBe` T.lines legacyBefore <> [supersededByLine "adoption-demo"]--          -- Adoption is not a content change: the generated tree is-          -- what a fresh workspace scaffold of the same members emits.-          withInlineWorkspace "keiro-dsl-workspace-adopt-fresh" adoptionMembers $ \_ fresh freshWorkspace -> do-            freshReport <- executePlannedWorkspaceScaffold fresh freshWorkspace-            (.migration) freshReport `shouldBe` Nothing-            adoptedTree <- treeSnapshot out-            freshTree <- treeSnapshot fresh-            haskellOnly adoptedTree `shouldBe` haskellOnly freshTree-      it "adopts and marks context history under the legacy record name" $-        withInlineWorkspace "keiro-dsl-workspace-adopt-legacy-name" adoptionMembers $ \_ out workspace -> do-          specA <- parseInlineSpec "domain/a.keiro" adoptionMemberA-          _ <- executePlannedScaffold out "domain/a.keiro" (defaultContext "adoption-demo") specA-          let current = contextLedgerFileName "adoption-demo"-              legacy = legacyContextRecordFileName "adoption-demo"-          renameFile (out </> current) (out </> legacy)-          ledgerBefore <- TIO.readFile (out </> legacy)-          report <- executePlannedWorkspaceScaffold out workspace-          case (.migration) report of-            Nothing -> expectationFailure "expected legacy-name context history to be adopted"-            Just migration -> (.legacyRecord) migration `shouldBe` Just (legacy, "domain/a.keiro")-          doesFileExist (out </> current) `shouldReturn` False-          ledgerAfter <- TIO.readFile (out </> legacy)-          T.lines ledgerAfter `shouldBe` T.lines ledgerBefore <> [supersededByLine "adoption-demo"]-          parseRecord ledgerAfter `shouldBe` parseRecord ledgerBefore-      it "lists hand-written files as unclaimed and leaves their bytes alone" $-        withInlineWorkspace "keiro-dsl-workspace-unclaimed" adoptionMembers $ \_ out workspace -> do-          plan <- shouldPlanWorkspaceSpec workspace-          case [(.path) m | (m, _) <- (.modules) plan, (.kind) m == HoleStub] of-            [] -> expectationFailure "adoption fixture emits no hole module"-            path : _ -> do-              writeFileWithParents (out </> path) "-- hand filled\n"-              writeFileWithParents (out </> "Notes.hs") "module Notes where\n"-              report <- executePlannedWorkspaceScaffold out workspace-              case (.migration) report of-                Nothing -> expectationFailure "expected a report for a directory holding hand-written files"-                Just migration -> do-                  (.legacyRecord) migration `shouldBe` Nothing-                  (.claimed) migration `shouldBe` []-                  (.unclaimed) migration `shouldBe` sort [path, "Notes.hs"]-              TIO.readFile (out </> path) `shouldReturn` "-- hand filled\n"-              TIO.readFile (out </> "Notes.hs") `shouldReturn` "module Notes where\n"-      it "never claims a bannerless file at a planned Generated path" $-        withInlineWorkspace "keiro-dsl-workspace-unattributable" adoptionMembers $ \_ out workspace -> do-          plan <- shouldPlanWorkspaceSpec workspace-          case [(.path) m | (m, _) <- (.modules) plan, (.kind) m == Generated] of-            [] -> expectationFailure "adoption fixture emits no Generated module"-            target : _ -> do-              writeFileWithParents (out </> target) "hand owned\n"-              refused <- executeWorkspaceScaffold out False plan-              refused `shouldSatisfy` isMissingBannerRefusal-              TIO.readFile (out </> target) `shouldReturn` "hand owned\n"-              doesFileExist (out </> "keiro-dsl-migration-report.workspace.adoption-demo.txt")-                `shouldReturn` False-      it "adopts at most once, and the second run is an ordinary idempotent run" $-        withInlineWorkspace "keiro-dsl-workspace-adopt-once" adoptionMembers $ \_ out workspace -> do-          specA <- parseInlineSpec "domain/a.keiro" adoptionMemberA-          _ <- executePlannedScaffold out "domain/a.keiro" (defaultContext "adoption-demo") specA-          first <- executePlannedWorkspaceScaffold out workspace-          (.migration) first `shouldSatisfy` \case Just _ -> True; Nothing -> False-          treeBefore <- treeSnapshot out-          reportBefore <- TIO.readFile (out </> "keiro-dsl-migration-report.workspace.adoption-demo.txt")-          legacyBefore <- TIO.readFile (out </> recordFileName "adoption-demo")--          second <- executePlannedWorkspaceScaffold out workspace-          (.migration) second `shouldBe` Nothing-          (.stale) second `shouldBe` []-          map thd3 ((.dispositions) second) `shouldSatisfy` all (`elem` [Unchanged, Skipped])-          treeSnapshot out `shouldReturn` treeBefore-          TIO.readFile (out </> "keiro-dsl-migration-report.workspace.adoption-demo.txt")-            `shouldReturn` reportBefore-          legacyAfter <- TIO.readFile (out </> recordFileName "adoption-demo")-          legacyAfter `shouldBe` legacyBefore-          length (filter (== supersededByLine "adoption-demo") (T.lines legacyAfter))-            `shouldBe` 1--comparisonProvenance :: CompareProvenance-comparisonProvenance =-  CompareProvenance-    { historicalCodecIdentity = "example.historical",-      historicalCodecVersion = "legacy-v1",-      canonicalType = CanonicalTypeId "example.Artifact.v1",-      bindingSymbol = QualifiedValueName "Example.Bindings.artifactBinding",-      bindingVersion = BindingVersion "1",-      wireFingerprint = "deadbeef"-    }--syntheticGenerated :: FilePath -> T.Text -> ScaffoldModule-syntheticGenerated path contents =-  ScaffoldModule {path = path, text = contents, kind = Generated, origin = "test"}--data GeneratedTreeDelta = GeneratedTreeDelta-  { changedPaths :: !(Set.Set FilePath),-    addedPaths :: !(Set.Set FilePath),-    removedPaths :: !(Set.Set FilePath),-    changedLineCounts :: !(Map.Map FilePath Int)-  }-  deriving stock (Eq, Show)--generatedTreeDelta :: [ScaffoldModule] -> [ScaffoldModule] -> GeneratedTreeDelta-generatedTreeDelta previous current =-  GeneratedTreeDelta-    { changedPaths = changed,-      addedPaths = added,-      removedPaths = removed,-      changedLineCounts = Map.fromSet changedLineCount impacted-    }-  where-    previousByPath = generatedByPath previous-    currentByPath = generatedByPath current-    previousPaths = Map.keysSet previousByPath-    currentPaths = Map.keysSet currentByPath-    added = currentPaths Set.\\ previousPaths-    removed = previousPaths Set.\\ currentPaths-    shared = previousPaths `Set.intersection` currentPaths-    changed = Set.filter (\path -> Map.lookup path previousByPath /= Map.lookup path currentByPath) shared-    impacted = changed <> added <> removed-    changedLineCount path = case (Map.lookup path previousByPath, Map.lookup path currentByPath) of-      (Just old, Just new) -> differingLineCount ((.text) old) ((.text) new)-      (Just old, Nothing) -> length (T.lines ((.text) old))-      (Nothing, Just new) -> length (T.lines ((.text) new))-      (Nothing, Nothing) -> 0-    generatedByPath modules = Map.fromList [((.path) value, value) | value <- modules, (.kind) value == Generated]--generatedTreeDeltaFromSnapshot :: [(FilePath, T.Text)] -> [(FilePath, T.Text)] -> GeneratedTreeDelta-generatedTreeDeltaFromSnapshot previous current =-  generatedTreeDelta-    [syntheticGenerated path contents | (path, contents) <- previous]-    [syntheticGenerated path contents | (path, contents) <- current]--differingLineCount :: T.Text -> T.Text -> Int-differingLineCount previous current =-  unequalShared + abs (length previousLines - length currentLines)-  where-    previousLines = T.lines previous-    currentLines = T.lines current-    unequalShared = length [() | (old, new) <- zip previousLines currentLines, old /= new]--assertAllowedGeneratedDelta :: Set.Set ModuleRole -> [ScaffoldModule] -> [ScaffoldModule] -> GeneratedTreeDelta -> Expectation-assertAllowedGeneratedDelta allowed previous current delta = do-  (.removedPaths) delta `shouldBe` Set.empty-  actualRoles `shouldSatisfy` (`Set.isSubsetOf` allowed)-  where-    modulesByPath = Map.fromList [((.path) value, value) | value <- previous <> current, (.kind) value == Generated]-    impacted = (.changedPaths) delta <> (.addedPaths) delta <> (.removedPaths) delta-    actualRoles = Set.fromList [moduleRole value | path <- Set.toList impacted, Just value <- [Map.lookup path modulesByPath]]--generatedTextEndingIn :: T.Text -> [ScaffoldModule] -> T.Text-generatedTextEndingIn suffix modules = case [(.text) m | m <- modules, (.kind) m == Generated, suffix `T.isSuffixOf` T.pack ((.path) m)] of-  contents : _ -> contents-  [] -> ""--generatedExtensionsEndingIn :: T.Text -> [ScaffoldModule] -> [T.Text]-generatedExtensionsEndingIn suffix modules = case [generatedModule | generatedModule <- modules, (.kind) generatedModule == Generated, suffix `T.isSuffixOf` T.pack ((.path) generatedModule)] of-  [generatedModule] -> generatedLocalExtensions generatedModule-  matches -> error ("expected one generated module ending in " <> T.unpack suffix <> ", got " <> show (map (.path) matches))--generatedLocalExtensions :: ScaffoldModule -> [T.Text]-generatedLocalExtensions generatedModule =-  [ extension-  | line <- takeWhile (T.isPrefixOf languagePrefix) (T.lines ((.text) generatedModule)),-    Just extensionWithSuffix <- [T.stripPrefix languagePrefix line],-    Just extension <- [T.stripSuffix languageSuffix extensionWithSuffix]-  ]-  where-    languagePrefix = "{-# LANGUAGE "-    languageSuffix = " #-}"--holeTextEndingIn :: T.Text -> [ScaffoldModule] -> T.Text-holeTextEndingIn suffix modules = case [(.text) m | m <- modules, (.kind) m == HoleStub, suffix `T.isSuffixOf` T.pack ((.path) m), not ("BehaviorHoles.hs" `T.isSuffixOf` T.pack ((.path) m))] of-  contents : _ -> contents-  [] -> ""--onlyAggregate :: Spec -> Aggregate-onlyAggregate spec = case [aggregate | NAggregate aggregate <- (.nodes) spec] of-  [aggregate] -> aggregate-  aggregates -> error ("expected one aggregate, got " <> show (length aggregates))--loweringAggregateSpec :: T.Text-loweringAggregateSpec =-  T.unlines-    [ "context samples",-      "",-      "aggregate Counter",-      "  regs",-      "    note Text = \"hello world\"",-      "    count Int = 0",-      "    state CounterVertex = Pending",-      "  states Pending Done!",-      "  command Bump { count:Int }",-      "  event CountBumped { count:Int }",-      "  Pending -- Bump --> emit CountBumped ; goto Done"-    ]--scalarRegisterCases :: [(T.Text, T.Text)]-scalarRegisterCases =-  [ ("Text", "\"sample\""),-    ("Int", "0"),-    ("Bool", "False"),-    ("Time", "\"2026-01-02T03:04:05.123456789012Z\""),-    ("Natural", "0")-  ]--cleanScalarAggregateSpec :: T.Text -> T.Text -> T.Text-cleanScalarAggregateSpec typeName initialValue =-  T.unlines-    [ "context clean-scalar",-      "",-      "aggregate Scalar",-      "  regs",-      "    value " <> typeName <> " = " <> initialValue,-      "  states Empty Done!",-      "  command Set { value:" <> typeName <> " }",-      "  event SetDone { value:" <> typeName <> " }",-      "  Empty -- Set --> write value := value ; emit SetDone ; goto Done"-    ]--exactStatusSpec :: T.Text-exactStatusSpec =-  T.unlines-    [ "context samples",-      "",-      "aggregate Reservation",-      "  regs",-      "    state ReservationVertex = Open",-      "  states Open Closed!",-      "  command Bump { count:Int }",-      "  event ReservationHeld { count:Int }",-      "  event ReservationUnHeld { count:Int }",-      "  event CountBumped { count:Int }",-      "  Open -- Bump --> emit CountBumped ; goto Closed",-      "  projection reservation_status consistency=Eventual key=count",-      "    status-map { ReservationHeld=>held ReservationUnHeld=>available CountBumped=>bumped }"-    ]--hasPathCollisionWithTwoOrigins :: Either [Refusal] [ScaffoldModule] -> Bool-hasPathCollisionWithTwoOrigins = \case-  Left refusals -> any hasTwo refusals-  Right _ -> False-  where-    hasTwo (PathCollision _ origins) = length origins == 2-    hasTwo _ = False--isMissingBannerRefusal :: Either [Refusal] a -> Bool-isMissingBannerRefusal = \case-  Left [MissingGeneratedBanner paths] -> not (null paths)-  _ -> False--isSuccessfulScaffold :: Either [Refusal] a -> Bool-isSuccessfulScaffold = \case-  Right _ -> True-  Left _ -> False---- Unit tests that construct semantic values directly still need to exercise--- the production planner's exact-source path. Promote the compatibility spans--- into an explicitly exact, complete index here; production code never--- fabricates this provenance.-syntheticExactSourceIndex :: Spec -> SemanticSourceIndex-syntheticExactSourceIndex spec =-  case compatibilitySemanticSourceIndex sourceName spec of-    Left failure -> error ("failed to construct the test source index: " <> show failure)-    Right compatibilityIndex ->-      case exactSemanticSourceIndex sourceName (semanticSourceSubjects spec) entries of-        Left failure -> error ("failed to promote the test source index: " <> show failure)-        Right exactIndex -> exactIndex-      where-        entries = [(subject, sourceSpan) | (subject, _, sourceSpan) <- semanticSourceEntries compatibilityIndex]-  where-    sourceName = "<test-exact>"--planTestServiceScaffold :: Context -> CheckedService -> Either [Refusal] [ScaffoldModule]-planTestServiceScaffold ctx service =-  planIndexedServiceScaffold (syntheticExactSourceIndex (checkedSpec service)) ctx service--planTestServiceScaffoldWithRuntimePackage :: Maybe RuntimePackageName -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]-planTestServiceScaffoldWithRuntimePackage runtimePackage ctx service =-  planIndexedServiceScaffoldWithRuntimePackage runtimePackage (syntheticExactSourceIndex (checkedSpec service)) ctx service--planTestScaffold :: Context -> Spec -> Either [Refusal] [ScaffoldModule]-planTestScaffold ctx spec = planTestServiceScaffold ctx (legacyCheckedService spec)--checkTestServiceDiagnostics :: Maybe RuntimePackageName -> Context -> CheckedService -> [Diagnostic]-checkTestServiceDiagnostics runtimePackage ctx service =-  checkIndexedServiceDiagnostics runtimePackage (syntheticExactSourceIndex (checkedSpec service)) ctx service--executePlannedScaffold :: FilePath -> FilePath -> Context -> Spec -> IO ScaffoldReport-executePlannedScaffold out specPath ctx spec = case planTestScaffold ctx spec of-  Left refusals -> expectationFailure ("unexpected scaffold refusal: " <> show refusals) >> error "unreachable"-  Right modules -> do-    result <- executeScaffold out False specPath ctx spec modules-    case result of-      Left refusals -> expectationFailure ("unexpected execution refusal: " <> show refusals) >> error "unreachable"-      Right report -> pure report--renameCounter :: Node -> Node-renameCounter (NAggregate aggregate) =-  NAggregate-    ( aggregateWithNameAndRegs-        "Widget"-        [regDeclWithValueType (if reg.valueType == TRef "CounterVertex" then TRef "WidgetVertex" else reg.valueType) reg | reg <- aggregate.regs]-        aggregate-    )-renameCounter node = node--onlyPathEndingIn :: FilePath -> [ScaffoldModule] -> FilePath-onlyPathEndingIn suffix modules = case [(.path) m | m <- modules, T.pack suffix `T.isSuffixOf` T.pack ((.path) m)] of-  [path] -> path-  paths -> error ("expected one path ending in " <> suffix <> ", got " <> show paths)--withTempDirectory :: String -> (FilePath -> IO a) -> IO a-withTempDirectory template = bracket acquire removePathForcibly-  where-    acquire = do-      base <- getTemporaryDirectory-      (path, handle) <- openTempFile base template-      hClose handle-      removeFile path-      createDirectory path-      pure path---- | Parse a fixture and return the validator's diagnostic codes (failing the--- test on a parse error).-diagnosticCodesOf :: FilePath -> IO [DiagnosticCode]-diagnosticCodesOf path = do-  map (.code) <$> diagnosticsOf path---- | Parse a fixture and return all validator diagnostics.-diagnosticsOf :: FilePath -> IO [Diagnostic]-diagnosticsOf path = do-  service <- checkedServiceOf path-  pure (validateService service)---- | Like 'diagnosticCodesOf' but only the Error-severity codes (warnings, e.g.--- the benign-inversion notices, are excluded).-errorCodesOf :: FilePath -> IO [DiagnosticCode]-errorCodesOf path = do-  diagnostics <- diagnosticsOf path-  pure [(.code) d | d <- diagnostics, (.severity) d == Error]---- | Parse two fixtures and diff them (old, new).--- | Plan 143: render an Expr in concrete guard syntax by printing a dummy--- transition through the real pretty-printer and slicing its guard clause,--- so the test exercises the exact printer the diff advisory uses.-renderExprText :: Expr -> T.Text-renderExprText e =-  case [T.strip l | l <- T.lines rendered, "guard " `T.isPrefixOf` T.strip l] of-    [guardLine] -> T.strip (T.drop (T.length "guard ") guardLine)-    _ -> error ("renderExprText: unexpected printer output: " <> T.unpack rendered)-  where-    rendered =-      renderTransition-        Transition-          { source = "S",-            command = "C",-            implementation = LegacyHoleImplementation,-            guard = Just e,-            writes = [],-            emits = [],-            outcome = Nothing,-            outcomeDuplicateLocs = [],-            goto = "S",-            mode = TmLive,-            loc = noLoc-          }---- | Plan 143: a minimal spec whose only transition is replay-only, with the--- supplied clause lines spliced into its body.-replayOnlySpecWith :: [T.Text] -> T.Text-replayOnlySpecWith clauseLines =-  T.unlines $-    [ "context hospital-capacity",-      "",-      "id TransferReservationId prefix=rsv",-      "",-      "aggregate Reservation",-      "  regs",-      "    reservationId    TransferReservationId = placeholder",-      "    reservationState ReservationVertex     = Unrequested",-      "  states Unrequested Held",-      "",-      "  command RequestTransferReservation { reservationId }",-      "",-      "  event TransferReservationCreated = fields(RequestTransferReservation)",-      "",-      "  replay-only Unrequested -- RequestTransferReservation -->"-    ]-      ++ clauseLines--diffFixtures :: FilePath -> FilePath -> IO [Change]-diffFixtures oldP newP = do-  old <- parsedSourceOf oldP-  new <- parsedSourceOf newP-  pure (diffSources old new)--kindOfChange :: Change -> ChangeKind-kindOfChange (Additive kind) = kind-kindOfChange (Advisory kind) = kind-kindOfChange (Breaking kind) = kind--generatedHaskellNameFindings :: [Change] -> [Change]-generatedHaskellNameFindings = filter ((== GeneratedHaskellNameChanged) . (.code) . kindOfChange)--assertGeneratedHaskellNameFinding :: Change -> Expectation-assertGeneratedHaskellNameFinding change = do-  change `shouldSatisfy` isAdvisory-  let kind = kindOfChange change-      compatibility = kind.vector-      nonBuildVerdicts =-        [ verdictFor surface compatibility-        | surface <- [PrivateHistoryRead, OldBinaryReadNewEvents, SnapshotHydration, PublicConsumer, PersistedIdentity]-        ]-  nonBuildVerdicts `shouldBe` replicate 5 VCompatible-  verdictFor ConsumerBuild compatibility `shouldBe` VAdvisory-  (.rollout) compatibility `shouldBe` Set.empty-  renderFinding change `shouldSatisfy` T.isInfixOf "consumer-build=advisory"-  remediationFor (kind.context) ((.code) kind)-    `shouldBe` RemedyRescaffoldGenerated :| [RemedyRecompileConsumers, RemedyRunConformance]--labelOfChange :: Change -> Label-labelOfChange Additive {} = LabelAdditive-labelOfChange Advisory {} = LabelAdvisory-labelOfChange Breaking {} = LabelBreaking--genSurfaceSet :: Gen (Set.Set CompatibilitySurface)-genSurfaceSet = Set.fromList <$> listOf (elements [minBound .. maxBound])--genCompatibilityVector :: Gen CompatibilityVector-genCompatibilityVector =-  CompatibilityVector-    <$> genVerdict-    <*> genVerdict-    <*> genVerdict-    <*> genVerdict-    <*> genVerdict-    <*> genVerdict-    <*> (Set.fromList <$> listOf (elements rolloutConstraints))-  where-    genVerdict = elements [VCompatible, VAdvisory, VBreaking, VNotApplicable]-    rolloutConstraints =-      [ RolloutStopTheWorld,-        RolloutWorkersFirst,-        RolloutDrainRequired,-        RolloutProducerLast,-        RolloutProducerFirst-      ]--replayImpactFixtures :: FilePath -> FilePath -> IO ReplayImpact-replayImpactFixtures oldPath newPath = do-  old <- checkedServiceOf oldPath-  new <- checkedServiceOf newPath-  pure (resolvedFold (ReplayImpact.replayImpactServices old new))--modifyAggregate :: Name -> (Aggregate -> Aggregate) -> Spec -> Spec-modifyAggregate target update spec =-  specWithNodes-    [ case node of-        NAggregate aggregate | aggregate.name == target -> NAggregate (update aggregate)-        _ -> node-    | node <- spec.nodes-    ]-    spec--modifyReadModel :: Name -> (ReadModelNode -> ReadModelNode) -> Spec -> Spec-modifyReadModel target update spec =-  specWithNodes-    [ case node of-        NReadModel readModel | readModel.name == target -> NReadModel (update readModel)-        _ -> node-    | node <- spec.nodes-    ]-    spec--setLegacySubscription :: Maybe T.Text -> ReadModelSupply -> ReadModelSupply-setLegacySubscription subscription supply = case supply of-  legacy@LegacyReadModelSupply {} -> legacy {legacySubscription = subscription}-  OwnerDerivedSupply -> OwnerDerivedSupply--setLegacyScope :: Maybe RmScope -> ReadModelSupply -> ReadModelSupply-setLegacyScope scope supply = case supply of-  legacy@LegacyReadModelSupply {} -> legacy {legacyScope = scope}-  OwnerDerivedSupply -> OwnerDerivedSupply--setLegacyFeed :: RmFeed -> ReadModelSupply -> ReadModelSupply-setLegacyFeed feed supply = case supply of-  legacy@LegacyReadModelSupply {} -> legacy {legacyFeed = feed}-  OwnerDerivedSupply -> OwnerDerivedSupply--setLegacyConsistency :: Consistency -> ReadModelSupply -> ReadModelSupply-setLegacyConsistency consistency supply = case supply of-  legacy@LegacyReadModelSupply {} -> legacy {legacyConsistency = consistency}-  OwnerDerivedSupply -> OwnerDerivedSupply--mapContract :: (ContractNode -> ContractNode) -> Spec -> Spec-mapContract update spec =-  specWithNodes [case node of { NContract contract -> NContract (update contract); _ -> node } | node <- spec.nodes] spec--mapIntake :: (IntakeNode -> IntakeNode) -> Spec -> Spec-mapIntake update spec =-  specWithNodes [case node of { NIntake intake -> NIntake (update intake); _ -> node } | node <- spec.nodes] spec--mapPgmqDispatch :: (PgmqDispatchNode -> PgmqDispatchNode) -> Spec -> Spec-mapPgmqDispatch update spec =-  specWithNodes [case node of { NPgmqDispatch dispatch -> NPgmqDispatch (update dispatch); _ -> node } | node <- spec.nodes] spec--mapRouter :: (RouterNode -> RouterNode) -> Spec -> Spec-mapRouter update spec =-  specWithNodes [case node of { NRouter router -> NRouter (update router); _ -> node } | node <- spec.nodes] spec--mapEmit :: (EmitNode -> EmitNode) -> Spec -> Spec-mapEmit update spec =-  specWithNodes [case node of { NEmit emitNode -> NEmit (update emitNode); _ -> node } | node <- spec.nodes] spec--mapWorkflow :: (WorkflowNode -> WorkflowNode) -> Spec -> Spec-mapWorkflow update spec =-  specWithNodes [case node of { NWorkflow workflow -> NWorkflow (update workflow); _ -> node } | node <- spec.nodes] spec--mapWorkqueue :: (WorkqueueNode -> WorkqueueNode) -> Spec -> Spec-mapWorkqueue update spec =-  specWithNodes [case node of { NWorkqueue queue -> NWorkqueue (update queue); _ -> node } | node <- spec.nodes] spec--mapDispatch :: (PgmqDispatchNode -> PgmqDispatchNode) -> Spec -> Spec-mapDispatch update spec =-  mapPgmqDispatch update spec--mapOperation :: (OperationNode -> OperationNode) -> Spec -> Spec-mapOperation update spec =-  specWithNodes [case node of { NOperation operation -> NOperation (update operation); _ -> node } | node <- spec.nodes] spec--mapPublisher :: (PublisherNode -> PublisherNode) -> Spec -> Spec-mapPublisher update spec =-  specWithNodes [case node of { NPublisher publisher -> NPublisher (update publisher); _ -> node } | node <- spec.nodes] spec--serviceErrorCodes :: Int -> Spec -> [DiagnosticCode]-serviceErrorCodes versionNumber spec =-  [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]-  where-    service = case languageVersion (fromIntegral versionNumber) >>= effectiveLanguageContractForVersion of-      Nothing -> error ("unsupported test language version " <> show versionNumber)-      Just languageContract -> checkedServiceForContract languageContract spec---- | Codes emitted at 'Warning' severity under the given released language.--- Pairs with 'serviceErrorCodes' to assert a surface's warn-then-error tiering--- from both sides, rather than only proving it is not an error.-serviceWarningCodes :: Int -> Spec -> [DiagnosticCode]-serviceWarningCodes versionNumber spec =-  [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Warning]-  where-    service = case languageVersion (fromIntegral versionNumber) >>= effectiveLanguageContractForVersion of-      Nothing -> error ("unsupported test language version " <> show versionNumber)-      Just languageContract -> checkedServiceForContract languageContract spec--duplicateFirst :: [a] -> [a]-duplicateFirst = \case-  [] -> []-  first : rest -> first : first : rest--updateFirst :: (a -> a) -> [a] -> [a]-updateFirst update = \case-  [] -> []-  first : rest -> update first : rest--removeReadModel :: Name -> Spec -> Spec-removeReadModel target spec =-  specWithNodes [node | node <- spec.nodes, not (isTarget node)] spec-  where-    isTarget (NReadModel readModel) = (.name) readModel == target-    isTarget _ = False--modifyRouter :: Name -> (RouterNode -> RouterNode) -> Spec -> Spec-modifyRouter target update spec =-  specWithNodes-    [ case node of-        NRouter router | router.id == target -> NRouter (update router)-        _ -> node-    | node <- spec.nodes-    ]-    spec--routerErrorCodes :: (RouterNode -> RouterNode) -> Spec -> [DiagnosticCode]-routerErrorCodes update = errorCodes . modifyRouter "PagingRouter" update--modifyProcess :: Name -> (ProcessNode -> ProcessNode) -> Spec -> Spec-modifyProcess target update spec =-  specWithNodes-    [ case node of-        NProcess process | process.id == target -> NProcess (update process)-        _ -> node-    | node <- spec.nodes-    ]-    spec--processErrorCodes :: (ProcessNode -> ProcessNode) -> Spec -> [DiagnosticCode]-processErrorCodes update = errorCodes . modifyProcess "HospitalSurge" update--errorCodes :: Spec -> [DiagnosticCode]-errorCodes spec = [(.code) diagnostic | diagnostic <- validateSpec spec, (.severity) diagnostic == Error]--diagnosticCodes :: Spec -> [DiagnosticCode]-diagnosticCodes = map (.code) . validateSpec--changeReadModelShape :: ReadModelNode -> ReadModelNode-changeReadModelShape readModel =-  readModel-    { columns = (.columns) readModel <> [RmColumn "reviewed_by" "text" False],-      shape = "fnv1a:0000000000000000"-    }---- | Assert a @new \<kind\>@ skeleton parses and validates with zero--- error-severity diagnostics.-assertSkeletonValid :: T.Text -> IO ()-assertSkeletonValid kind = case skeletonFor kind of-  Left err -> expectationFailure (T.unpack ("skeleton for " <> kind <> ": " <> err))-  Right src -> case parseSpec ("new:" <> T.unpack kind) src of-    Left perr -> expectationFailure (T.unpack ("skeleton for " <> kind <> " failed to parse: " <> perr))-    Right spec ->-      [(.code) d | d <- validateSpec spec, (.severity) d == Error]-        `shouldBe` ([] :: [DiagnosticCode])--assertSkeletonUsesAuthoringLanguage :: T.Text -> IO ()-assertSkeletonUsesAuthoringLanguage kind = case skeletonFor kind of-  Left err -> expectationFailure (T.unpack ("skeleton for " <> kind <> ": " <> err))-  Right source -> case parseSource ("new:" <> T.unpack kind) source of-    Left failure -> expectationFailure (T.unpack (renderParseFailure failure))-    Right parsed -> do-      let service = checkedSource parsed-      (.contractLanguageVersion) (checkedLanguageContract service) `shouldBe` currentAuthoringLanguageVersion-      effectiveLanguageSupport (checkedLanguageContract service) `shouldBe` Stable-      [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]-        `shouldBe` ([] :: [DiagnosticCode])-      scaffoldServiceModules (defaultContext ((checkedSpec service).context)) service-        `shouldSatisfy` (not . null)--assertSkeletonScaffoldable :: T.Text -> IO ()-assertSkeletonScaffoldable kind = case skeletonFor kind of-  Left err -> expectationFailure (T.unpack ("skeleton for " <> kind <> ": " <> err))-  Right src -> case parseSpec ("new:" <> T.unpack kind) src of-    Left perr -> expectationFailure (T.unpack perr)-    Right spec -> planTestScaffold (defaultContext (spec.context)) spec `shouldSatisfy` isSuccessfulScaffold--bumpArtifactBindingVersion :: MappedDecl -> MappedDecl-bumpArtifactBindingVersion declaration@MappedStructural {msName = "ArtifactInfo"} =-  declaration {msBindingVersion = Just "2"}-bumpArtifactBindingVersion declaration = declaration--addArtifactSummaryField :: MappedDecl -> MappedDecl-addArtifactSummaryField declaration@MappedStructural {msName = "ArtifactInfo", msShape = ShapeRecord constructor unknownFields fields} =-  declaration-    { msShape =-        ShapeRecord-          constructor-          unknownFields-          ( fields-              <> [ WireField-                     { haskell = "summary",-                       key = "summary",-                       valueType = TText,-                       presence = PRequired,-                       onMissing = Nothing,-                       loc = Loc 0-                     }-                 ]-          )-    }-addArtifactSummaryField declaration = declaration--addAlphaPayloadOptionalField :: Spec -> Spec-addAlphaPayloadOptionalField = addMappedOptionalTextField "AlphaPayload" "note"--addNestedPayloadOptionalField :: Spec -> Spec-addNestedPayloadOptionalField = addMappedOptionalTextField "NestedPayload" "detail"--addMappedOptionalTextField :: Name -> Name -> Spec -> Spec-addMappedOptionalTextField target name spec = spec {mapped = map addField ((.mapped) spec)}-  where-    addField declaration@MappedStructural {msName = declarationName, msShape = ShapeRecord constructor unknownFields fields}-      | declarationName == target =-          declaration-            { msShape =-                ShapeRecord-                  constructor-                  unknownFields-                  ( fields-                      <> [ WireField-                             { haskell = name,-                               key = name,-                               valueType = TOptional TText,-                               presence = POptional,-                               onMissing = Just OmNull,-                               loc = Loc 0-                             }-                         ]-                  )-            }-    addField declaration = declaration--changeAlphaPayloadFixtureSymbol :: Spec -> Spec-changeAlphaPayloadFixtureSymbol spec = spec {mapped = map changeFixture ((.mapped) spec)}-  where-    changeFixture declaration@MappedStructural {msName = "AlphaPayload"} =-      declaration {msFixtures = Just "Example.SemanticLocality.Bindings.alphaPayloadV2Cases"}-    changeFixture declaration = declaration--mapWorkspaceSpec :: (Spec -> Spec) -> WorkspaceSpec -> WorkspaceSpec-mapWorkspaceSpec transform workspace =-  workspaceWithMembersAndMergedSpec-    [workspaceMemberWithSpec (transform member.spec) member | member <- workspace.members]-    (transform workspace.mergedSpec)-    workspace--expectGenericCompileFailure :: FilePath -> String -> Expectation-expectGenericCompileFailure fixture expectedDiagnostic =-  withTempDirectory ("keiro-dsl-generic-" <> fixture) $ \fixtureDir -> do-    let fixtureSource = fixtureDir </> "Fixture.hs"-        domainSource = fixtureDir </> "Domain.hs"-        shapeSource = fixtureDir </> "Shape.hs"-        recordModule moduleName fields =-          T.unlines-            [ "{-# LANGUAGE DeriveGeneric #-}",-              "module " <> moduleName <> " (Item (..)) where",-              "import Data.Text (Text)",-              "import GHC.Generics (Generic)",-              "data Item = Exact {" <> fields <> "}",-              "  deriving stock (Generic)"-            ]-        (domainFields, shapeFields) = case fixture of-          "renamed-field" -> ("contentHash :: Text", "contentDigest :: Text")-          "reordered-field" -> ("first :: Text, second :: Int", "second :: Int, first :: Text")-          "arity-mismatch" -> ("first :: Text", "first :: Text, second :: Int")-          "incompatible-type" -> ("content :: Text", "content :: Int")-          other -> error ("unknown generic compile-fail fixture: " <> other)-    TIO.writeFile domainSource (recordModule "Domain" domainFields)-    TIO.writeFile shapeSource (recordModule "Shape" shapeFields)-    TIO.writeFile-      fixtureSource-      ( T.unlines-          [ "module Fixture where",-            "import Domain qualified",-            "import Keiro.Codec.Structural (StructuralBinding)",-            "import Keiro.Codec.Structural.Generic (genericStructuralBinding)",-            "import Shape qualified",-            "binding :: StructuralBinding Domain.Item Shape.Item",-            "binding = genericStructuralBinding"-          ]-      )-    keiroCorePackageId <- activeCabalPackageId "keiro-core"-    (exitCode, standardOutput, standardError) <--      readProcessWithExitCode-        "cabal"-        [ "exec",-          "--enable-tests",-          "--",-          "ghc",-          "-XGHC2024",-          "-fno-code",-          "-fforce-recomp",-          "-package-id",-          keiroCorePackageId,-          "-i" <> fixtureDir,-          fixtureSource-        ]-        ""-    exitCode `shouldSatisfy` (/= ExitSuccess)-    let compilerOutput = standardOutput <> standardError-    compilerOutput `shouldContain` expectedDiagnostic-    compilerOutput `shouldContain` "Run keiro-dsl scaffold and fill the binding by hand at this error location in the scaffolded module."-    compilerOutput `shouldContain` takeFileName fixtureSource--activeCabalPackageId :: String -> IO String-activeCabalPackageId packageName = do-  planPaths <- filterM doesFileExist ["dist-newstyle/cache/plan.json", "../dist-newstyle/cache/plan.json"]-  planPath <- case planPaths of-    candidate : _ -> pure candidate-    [] -> expectationFailure "could not find Cabal's dist-newstyle/cache/plan.json" >> fail "unreachable"-  decodedPlan <- Aeson.eitherDecodeFileStrict' planPath :: IO (Either String Value)-  let packageIds = case decodedPlan of-        Right (Aeson.Object plan) -> case KeyMap.lookup "install-plan" plan of-          Just (Aeson.Array entries) ->-            [ T.unpack packageId-            | Aeson.Object entry <- toList entries,-              KeyMap.lookup "pkg-name" entry == Just (Aeson.String (T.pack packageName)),-              KeyMap.lookup "component-name" entry == Just (Aeson.String "lib"),-              Just (Aeson.String packageId) <- [KeyMap.lookup "id" entry]-            ]-          _ -> []-        _ -> []-  case packageIds of-    [packageId] -> pure packageId-    resolvedPackageIds ->-      expectationFailure-        ( "could not resolve one active Cabal package ID for "-            <> packageName-            <> ": "-            <> show resolvedPackageIds-            <> either (\decodeError -> " (plan decode failed: " <> decodeError <> ")") (const "") decodedPlan-        )-        >> fail "unreachable"--moveArtifactBindingIntoGenerated :: MappedDecl -> MappedDecl-moveArtifactBindingIntoGenerated declaration@MappedStructural {msName = "ArtifactInfo"} =-  declaration {msBinding = Just "Generated.ConsumerDemo.Bindings.artifactInfoBinding"}-moveArtifactBindingIntoGenerated declaration = declaration--removeMappedRegisterRequirements :: Spec -> Spec-removeMappedRegisterRequirements spec =-  spec-    { mapped = map removeInitial ((.mapped) spec),-      nodes = map removeRegisters ((.nodes) spec)-    }-  where-    removeInitial declaration@MappedStructural {} = declaration {msInitial = Nothing}-    removeInitial declaration@MappedOpaque {} = declaration {moInitial = Nothing}-    removeRegisters (NAggregate aggregate) =-      NAggregate-        aggregate-          { regs = [],-            transitions = [transition {writes = []} | transition <- (.transitions) aggregate]-          }-    removeRegisters node = node--isImportCycle :: Refusal -> Bool-isImportCycle ImportCycle {} = True-isImportCycle _ = False--isFoldSurfaceRefusal :: Either [Refusal] modules -> Bool-isFoldSurfaceRefusal (Left refusals) = any isFold refusals-  where-    isFold FoldSurfaceRefusal {} = True-    isFold _ = False-isFoldSurfaceRefusal (Right _) = False---- | The canonical positive workspace fixture: three members under one context.-canonicalWorkspacePath :: FilePath-canonicalWorkspacePath = "test/fixtures/workspace/service.keiro-workspace"---- | Deterministic workspace source used to model git blobs without invoking git.-memoryContentSource :: Map.Map FilePath T.Text -> ContentSource-memoryContentSource files =-  ContentSource-    { csRead = \path ->-        pure $ maybe (Left ("missing in-memory content: " <> T.pack path)) Right (Map.lookup path files)-    }--changeCode :: Change -> DiagnosticCode-changeCode (Additive kind) = (.code) kind-changeCode (Advisory kind) = (.code) kind-changeCode (Breaking kind) = (.code) kind--breakingSurfaces :: Change -> [CompatibilitySurface]-breakingSurfaces change =-  [ surface-  | surface <- [minBound .. maxBound],-    verdictFor surface (kind.vector) == VBreaking-  ]-  where-    kind = case change of-      Additive value -> value-      Advisory value -> value-      Breaking value -> value--workspaceChangeKind :: Change -> ChangeKind-workspaceChangeKind (Additive kind) = kind-workspaceChangeKind (Advisory kind) = kind-workspaceChangeKind (Breaking kind) = kind---- | The same members as 'canonicalWorkspacePath', listed in reverse order.-reorderedWorkspacePath :: FilePath-reorderedWorkspacePath = "test/fixtures/workspace/service-reordered.keiro-workspace"---- | Load and compose a workspace fixture, failing the test on a refusal. The--- fixture path is package-relative; the loader is rooted at the manifest's own--- directory, exactly as the CLI roots it.-shouldComposeWorkspace :: FilePath -> IO WorkspaceSpec-shouldComposeWorkspace path = do-  resolved <- resolveTestPath path-  loaded <- loadWorkspace (fileContentSource (takeDirectory resolved)) resolved-  case loaded of-    Left failure ->-      expectationFailure (T.unpack (T.intercalate "\n" (renderWorkspaceFailure resolved failure)))-        >> error "unreachable"-    Right workspace -> pure (workspaceWithManifestPath path workspace)---- | The 'Context' a workspace scaffolds under, with no CLI overrides: the--- members' unanimous name.context, the manifest's module-root and layout--- authority, and the built-in defaults where the manifest is silent.-workspaceContext :: WorkspaceSpec -> Context-workspaceContext workspace =-  Context-    { name = workspace.context,-      moduleRoot = maybe "" id ((.moduleRoot) workspace),-      placement = maybe GeneratedPrefix id ((.layout) workspace)-    }---- | Compose and plan a workspace fixture, failing the test on any refusal.-shouldPlanWorkspace :: FilePath -> IO WorkspacePlan-shouldPlanWorkspace path = do-  workspace <- shouldComposeWorkspace path-  case planWorkspaceScaffold "goldens" (workspaceContext workspace) workspace of-    Left refusals -> expectationFailure ("unexpected workspace plan refusal: " <> show refusals) >> error "unreachable"-    Right plan -> pure plan---- | Does a scaffolded module's path end in this suffix?-isSuffixOfPath :: FilePath -> ScaffoldModule -> Bool-isSuffixOfPath suffix m = T.pack suffix `T.isSuffixOf` T.pack ((.path) m)---- | A workspace record built from real composed data plus two synthetic--- adoption rows, so the round-trip test exercises every row kind including the--- JSON encodings shared with the v1 record.-sampleWorkspaceRecord :: WorkspaceSpec -> WorkspaceRecord-sampleWorkspaceRecord workspace =-  WorkspaceRecord-    { service = (.service) workspace,-      manifest = "service.keiro-workspace",-      context = workspace.context,-      moduleRoot = maybe "" id ((.moduleRoot) workspace),-      layout = "collocated",-      members = map (.path) ((.members) workspace),-      sourceLanguages =-        [ WorkspaceSourceLanguageRow ((.path) member) ((.sourceLanguage) member)-        | member <- (.members) workspace-        ],-      languageContract = (.languageContract) workspace,-      namingEdition = IdiomaticNamingV1,-      modules =-        [ WorkspaceModuleRow Generated "Demo/Generated/StructuralProjections.hs" Nothing Nothing,-          WorkspaceModuleRow Generated "Demo/Project/Generated/Domain.hs" (Just "domain/project.keiro") Nothing,-          WorkspaceModuleRow HoleStub "Demo/Project/Holes.hs" (Just "domain/shared.keiro") Nothing-        ],-      mappings = (.mappings) (consumerPlan ((.mergedSpec) workspace)),-      idDomains = [],-      nominalEqualities = nominalEqualityIdentities ((.mergedSpec) workspace),-      bindingObligations = either (const []) id (bindingHoles ((.mergedSpec) workspace)),-      requirements = [],-      projectionCatalogFacts = [],-      queryContractBaseline = True,-      queryContracts = either (const []) id (queryContractIdentities ((.mergedSpec) workspace)),-      routerSelections = [],-      adopted =-        [ AdoptedRow "claimed/One.hs" "record" (Just "keiro-dsl-ledger.context.demo-project.txt") (Just "project.keiro"),-          AdoptedRow "claimed/Two.hs" "banner" Nothing Nothing-        ],-      semanticImpact = Just (semanticImpactSnapshotForSpec ((.mergedSpec) workspace))-    }---- | Representative byte contracts for the two line-oriented scaffold ledgers.--- The behavior rows and semantic snapshot come from one checked source fixture;--- the query row is deliberately explicit so the golden scopes that serialized--- contract even though the behavior fixture itself has no read model.-representativeRecordMigrationContracts :: IO (ScaffoldRecord, WorkspaceRecord)-representativeRecordMigrationContracts = do-  parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"-  let service = checkedSource parsed-      spec = checkedSpec service-      sourceLanguageForm = (.sourceLanguage) parsed-      queryIdentity =-        QueryContractIdentity-          { readModel = "BehaviorSummary",-            position = QueryInputConsumer,-            typeExpression = "RequestId",-            mappedDependencies = ["RequestId"]-          }-  requirements <--    either-      (\errors -> expectationFailure (show errors) >> fail "unreachable")-      pure-      (Behavior.deriveBehaviorRequirements spec)-  let behaviorRows = Behavior.behaviorRecordRows requirements-      impact = Just (semanticImpactSnapshotForSpec spec)-      singleRecord =-        ScaffoldRecord-          { specPath = "behavior-complete.keiro",-            moduleRoot = "",-            layout = "prefixed",-            sourceLanguage = sourceLanguageForm,-            languageContract = checkedLanguageContract service,-            namingEdition = IdiomaticNamingV2,-            moduleRoles = [],-            files = [],-            mappings = [],-            idDomains = [],-            nominalEqualities = [],-            bindingObligations = [],-            behaviorRequirements = behaviorRows,-            projectionCatalogFacts = [],-            queryContractBaseline = True,-            queryContracts = [queryIdentity],-            routerSelections = [],-            semanticImpact = impact-          }-      workspaceRecord =-        WorkspaceRecord-          { service = "behavior-contract-fixture",-            manifest = "service.keiro-workspace",-            context = spec.context,-            moduleRoot = "",-            layout = "prefixed",-            members = ["behavior-complete.keiro"],-            sourceLanguages = [WorkspaceSourceLanguageRow "behavior-complete.keiro" sourceLanguageForm],-            languageContract = checkedLanguageContract service,-            namingEdition = IdiomaticNamingV1,-            modules = [],-            mappings = [],-            idDomains = [],-            nominalEqualities = [],-            bindingObligations = [],-            requirements = behaviorRows,-            projectionCatalogFacts = [],-            queryContractBaseline = True,-            queryContracts = [queryIdentity],-            routerSelections = [],-            adopted = [],-            semanticImpact = impact-          }-  pure (singleRecord, workspaceRecord)--semanticImpactSnapshotForSpec :: Spec -> SemanticImpactSnapshot-semanticImpactSnapshotForSpec = semanticImpactSnapshot . semanticImpactForSpec--semanticImpactForSpec :: Spec -> SemanticImpact-semanticImpactForSpec spec = case resolveTypeGraph spec of-  Left failures -> error ("test fixture type graph did not resolve: " <> show failures)-  Right graph -> semanticImpact graph---- | Test-facing selection from the production semantic authority. This does--- not walk the raw 'Spec' or reconstruct dependency edges.-data MappedSurfaceQualification = MappedSurfaceQualification-  { declaration :: !MappedKey,-    evidence :: !(Set.Set MappedRootEvidence),-    consumers :: !(Set.Set MappedConsumer),-    consequences :: !(Set.Set MappedConsequence)-  }-  deriving stock (Eq, Show)--qualifyMappedSurface :: SemanticImpact -> MappedKey -> MappedSurfaceQualification-qualifyMappedSurface impact key =-  MappedSurfaceQualification-    { declaration = key,-      evidence = Map.findWithDefault Set.empty key ((.declarationEvidence) impact),-      consumers = Map.findWithDefault Set.empty key ((.declarationConsumers) impact),-      consequences = Map.findWithDefault Set.empty key ((.declarationConsequences) impact)-    }---- | The canonical workspace with a case-variant copy of one member's aggregate--- grafted onto another member. Composition refuses this shape (EP-153 catches it--- at the earliest boundary), so the planner's own cross-member collision gate can--- only be exercised by constructing the graph directly — which is exactly what--- this does, mirroring the single-file @caseVariant@ construction.-withCaseVariantAggregate :: WorkspaceSpec -> WorkspaceSpec-withCaseVariantAggregate workspace = case [aggregate | NAggregate aggregate <- (.nodes) merged, (.name) aggregate == "Project"] of-  [] -> error "canonical workspace fixture has no Project aggregate"-  aggregate : _ ->-    let shouted = aggregateWithName (T.toUpper aggregate.name) aggregate-        ownershipIndex = workspace.ownership-        mergedWithVariant = specWithNodes (merged.nodes <> [NAggregate shouted]) merged-        ownershipWithVariant =-          OwnershipIndex-            { declarations = ownershipIndex.declarations,-              nodes = Map.insert ("aggregate", shouted.name) ("domain/project-artifact.keiro", Loc 1) ownershipIndex.nodes-            }-     in workspaceWithMergedSpecAndOwnership mergedWithVariant ownershipWithVariant workspace-  where-    merged = (.mergedSpec) workspace---- | Write a one-member workspace whose member declares an upcaster, so its--- golden payload fixture has a canonical location. Returns the composed--- workspace; the caller decides where the fixture lives.-writeGoldenWorkspace :: FilePath -> IO WorkspaceSpec-writeGoldenWorkspace root = do-  source <- readTestText "test/fixtures/reservation-v2.keiro"-  createDirectoryIfMissing True (root </> "domain")-  TIO.writeFile (root </> "domain/reservation.keiro") source-  let manifestPath = root </> "service.keiro-workspace"-  TIO.writeFile manifestPath "service gold-demo\nspec domain/reservation.keiro\n"-  loaded <- loadWorkspace (fileContentSource root) manifestPath-  case loaded of-    Left failure ->-      expectationFailure (T.unpack (T.intercalate "\n" (renderWorkspaceFailure manifestPath failure)))-        >> error "unreachable"-    Right workspace -> pure workspace---- | Materialize the canonical fixture workspace in a fresh temporary directory--- and hand the callback its root, a sibling output directory, and the composed--- workspace. Working on a copy is what lets a test edit a member and re-scaffold.------ The manifest's @spec@ lines are passed through the given function first, so a--- caller can list the same members in a different order; the manifest __file--- name__ stays the same, which is what makes two runs comparable byte for byte.-withWorkspaceFixture ::-  String ->-  ([FilePath] -> [FilePath]) ->-  (FilePath -> FilePath -> WorkspaceSpec -> IO a) ->-  IO a-withWorkspaceFixture template orderMembers act =-  withTempDirectory template $ \base -> do-    let root = base </> "workspace"-        out = base </> "out"-        members =-          [ "domain/project-artifact.keiro",-            "domain/project.keiro",-            "domain/shared.keiro"-          ]-    createDirectoryIfMissing True (root </> "domain")-    forM_ members $ \relative -> do-      source <- readTestText ("test/fixtures/workspace" </> relative)-      TIO.writeFile (root </> relative) source-    TIO.writeFile-      (root </> "service.keiro-workspace")-      ( T.unlines-          ( ["service demo-project", "module Demo.Modules.Project", "layout collocated"]-              <> ["spec " <> T.pack relative | relative <- orderMembers members]-          )-      )-    workspace <- loadTempWorkspace root-    act root out workspace--withSemanticLocalityFixture ::-  String ->-  ([FilePath] -> [FilePath]) ->-  Int ->-  (FilePath -> FilePath -> WorkspaceSpec -> IO a) ->-  IO a-withSemanticLocalityFixture template orderMembers unrelatedCount act =-  withTempDirectory template $ \base -> do-    let root = base </> "workspace"-        out = base </> "out"-        members = ["domain/alpha.keiro", "domain/beta.keiro"]-    forM_ members $ \relative -> do-      source <- readTestText ("test/fixtures/semantic-locality" </> relative)-      let withUnrelated-            | relative == "domain/beta.keiro" = source <> unrelatedAggregatesSource unrelatedCount-            | otherwise = source-      writeFileWithParents (root </> relative) withUnrelated-    TIO.writeFile-      (root </> "service.keiro-workspace")-      (T.unlines ("service semantic-locality" : ["spec " <> T.pack relative | relative <- orderMembers members]))-    workspace <- loadTempWorkspace root-    act root out workspace--unrelatedAggregatesSource :: Int -> T.Text-unrelatedAggregatesSource count =-  T.unlines-    ( concat-        [ [ "",-            "aggregate Unrelated" <> suffix,-            "  regs",-            "    marker Bool = False",-            "  states Ready Done!",-            "  command SubmitUnrelated" <> suffix <> " { accepted:Bool }",-            "  event Unrelated" <> suffix <> "Submitted = fields(SubmitUnrelated" <> suffix <> ")",-            "  Ready -- SubmitUnrelated" <> suffix <> " --> guard cmd.accepted ; write marker := true ; emit Unrelated" <> suffix <> "Submitted ; goto Done"-          ]-        | index <- [1 .. count],-          let suffix = T.pack (show index)-        ]-    )---- | Materialize an inline workspace — a manifest plus literal member sources —--- in a fresh temporary directory, and hand the callback its root, a sibling output--- directory, and the composed workspace.-withInlineWorkspace ::-  String ->-  (T.Text, [(FilePath, T.Text)]) ->-  (FilePath -> FilePath -> WorkspaceSpec -> IO a) ->-  IO a-withInlineWorkspace template (service, members) act =-  withTempDirectory template $ \base -> do-    let root = base </> "workspace"-        out = base </> "out"-    forM_ members $ \(relative, source) -> writeFileWithParents (root </> relative) source-    TIO.writeFile-      (root </> "service.keiro-workspace")-      ( T.unlines-          (("service " <> service) : ["spec " <> T.pack relative | (relative, _) <- members])-      )-    workspace <- loadTempWorkspace root-    act root out workspace---- | Two independently valid members under one context. Each is a complete spec--- that the pre-workspace single-file scaffolder accepts, which is what lets a test--- reproduce the overwritten-record defect before adopting.-adoptionMembers :: (T.Text, [(FilePath, T.Text)])-adoptionMembers = ("adoption-demo", [("domain/a.keiro", adoptionMemberA), ("domain/b.keiro", adoptionMemberB)])--adoptionMemberA :: T.Text-adoptionMemberA =-  T.unlines-    [ "context adoption-demo",-      "",-      "aggregate Counter",-      "  regs",-      "    count Int = 0",-      "    state CounterVertex = Pending",-      "  states Pending Done!",-      "  command Bump { count:Int }",-      "  event CountBumped { count:Int }",-      "  Pending -- Bump --> emit CountBumped ; goto Done"-    ]--adoptionMemberB :: T.Text-adoptionMemberB =-  T.unlines-    [ "context adoption-demo",-      "",-      "aggregate Widget",-      "  regs",-      "    size Int = 0",-      "    state WidgetVertex = Draft",-      "  states Draft Shipped!",-      "  command Ship { size:Int }",-      "  event WidgetShipped { size:Int }",-      "  Draft -- Ship --> emit WidgetShipped ; goto Shipped"-    ]--writeFileWithParents :: FilePath -> T.Text -> IO ()-writeFileWithParents path contents = do-  createDirectoryIfMissing True (takeDirectory path)-  TIO.writeFile path contents---- | Only the Haskell sources of a tree snapshot, dropping bookkeeping files.-haskellOnly :: [(FilePath, T.Text)] -> [(FilePath, T.Text)]-haskellOnly entries = [entry | entry@(path, _) <- entries, ".hs" `T.isSuffixOf` T.pack path]---- | Compose a workspace that a test just wrote to disk.-loadTempWorkspace :: FilePath -> IO WorkspaceSpec-loadTempWorkspace root = do-  let manifestPath = root </> "service.keiro-workspace"-  loaded <- loadWorkspace (fileContentSource root) manifestPath-  case loaded of-    Left failure ->-      expectationFailure (T.unpack (T.intercalate "\n" (renderWorkspaceFailure manifestPath failure)))-        >> error "unreachable"-    Right workspace -> pure workspace---- | Plan an already-composed workspace, failing the test on a refusal.-shouldPlanWorkspaceSpec :: WorkspaceSpec -> IO WorkspacePlan-shouldPlanWorkspaceSpec workspace =-  case planWorkspaceScaffold "goldens" (workspaceContext workspace) workspace of-    Left refusals -> expectationFailure ("unexpected workspace plan refusal: " <> show refusals) >> error "unreachable"-    Right plan -> pure plan---- | Plan then execute a whole-workspace scaffold, failing loudly on either.-executePlannedWorkspaceScaffold :: FilePath -> WorkspaceSpec -> IO WorkspaceScaffoldReport-executePlannedWorkspaceScaffold out workspace = do-  plan <- shouldPlanWorkspaceSpec workspace-  result <- executeWorkspaceScaffold out False plan-  case result of-    Left refusals -> expectationFailure ("unexpected workspace execution refusal: " <> show refusals) >> error "unreachable"-    Right report -> pure report---- | Rename one member's aggregate in place and recompose. Only the--- @aggregate \<Name\>@ header is rewritten, so declarations that merely share the--- prefix (@ProjectId@, @ProjectSummary@) are untouched.-renameMemberAggregate :: FilePath -> FilePath -> T.Text -> T.Text -> IO WorkspaceSpec-renameMemberAggregate root member from to = do-  source <- TIO.readFile (root </> member)-  TIO.writeFile (root </> member) (T.replace ("aggregate " <> from <> "\n") ("aggregate " <> to <> "\n") source)-  loadTempWorkspace root---- | Move the @ProjectArtifact@ aggregate from the artifact member into the--- project member, and recompose.------ It is prepended, so the merged spec's node order — and therefore every emitted--- byte, including the replay-audit assembly's aggregate list — is exactly what it--- was. That isolates the change to ownership, which is the point of the test.-moveArtifactAggregate :: FilePath -> IO WorkspaceSpec-moveArtifactAggregate root = do-  artifact <- TIO.readFile (root </> "domain/project-artifact.keiro")-  project <- TIO.readFile (root </> "domain/project.keiro")-  case T.breakOn "aggregate ProjectArtifact" artifact of-    (kept, moved) | not (T.null moved) -> do-      TIO.writeFile (root </> "domain/project-artifact.keiro") kept-      TIO.writeFile-        (root </> "domain/project.keiro")-        (T.replace "aggregate Project\n" (moved <> "\naggregate Project\n") project)-      loadTempWorkspace root-    _ -> expectationFailure "artifact member has no ProjectArtifact aggregate" >> error "unreachable"---- | Every regular file under a directory, as @(relative path, contents)@ sorted--- by path — the comparison unit for "byte-identical output".-treeSnapshot :: FilePath -> IO [(FilePath, T.Text)]-treeSnapshot root = do-  exists <- doesDirectoryExist root-  if not exists then pure [] else sort <$> walk ""-  where-    walk relative = do-      entries <- listDirectory (root </> relative)-      fmap concat . forM (sort entries) $ \entry -> do-        let child = if null relative then entry else relative </> entry-        isDirectory <- doesDirectoryExist (root </> child)-        if isDirectory-          then walk child-          else do-            contents <- TIO.readFile (root </> child)-            pure [(child, contents)]--scaffoldRecordWithEdition :: GeneratedHaskellNamingEdition -> ScaffoldRecord -> ScaffoldRecord-scaffoldRecordWithEdition edition record = case record of-  ScaffoldRecord-    recordSpecPath-    recordModuleRoot-    recordLayout-    recordSourceLanguage-    recordLanguageContract-    _recordNamingEdition-    recordModuleRoles-    recordFiles-    recordMappings-    recordIdDomains-    recordNominalEqualities-    recordBindingObligations-    recordBehaviorRequirements-    recordProjectionCatalogFacts-    recordQueryContractBaseline-    recordQueryContracts-    recordRouterSelections-    recordSemanticImpact ->-      ScaffoldRecord-        recordSpecPath-        recordModuleRoot-        recordLayout-        recordSourceLanguage-        recordLanguageContract-        edition-        recordModuleRoles-        recordFiles-        recordMappings-        recordIdDomains-        recordNominalEqualities-        recordBindingObligations-        recordBehaviorRequirements-        recordProjectionCatalogFacts-        recordQueryContractBaseline-        recordQueryContracts-        recordRouterSelections-        recordSemanticImpact--copyTextTree :: FilePath -> FilePath -> IO ()-copyTextTree source destination =-  treeSnapshot source >>= mapM_ (\(relative, contents) -> writeFileWithParents (destination </> relative) contents)--thd3 :: (a, b, c) -> c-thd3 (_, _, value) = value--isPathCollision :: Refusal -> Bool-isPathCollision PathCollision {} = True-isPathCollision _ = False--isInfixOfString :: String -> String -> Bool-isInfixOfString needle haystack = T.isInfixOf (T.pack needle) (T.pack haystack)---- | Load a workspace fixture expecting a compose refusal, and return it.-shouldRefuseWorkspace :: FilePath -> IO (NonEmpty WorkspaceDiagnostic)-shouldRefuseWorkspace path = do-  resolved <- resolveTestPath path-  loaded <- loadWorkspace (fileContentSource (takeDirectory resolved)) resolved-  case loaded of-    Left (WorkspaceRefused diagnostics) -> pure diagnostics-    Left other ->-      expectationFailure-        ("expected compose refusals, got:\n" <> T.unpack (T.intercalate "\n" (renderWorkspaceFailure resolved other)))-        >> error "unreachable"-    Right _ -> expectationFailure ("expected " <> path <> " to be refused") >> error "unreachable"---- | Invoke the built @keiro-dsl@ executable. Fixture paths are resolved first,--- so the test works whether it runs from the package directory or the repository--- root.-runKeiroDsl :: [String] -> IO (ExitCode, String, String)-runKeiroDsl arguments = do-  resolved <- traverse resolveArgument arguments-  -- Cabal places build-tool dependencies on PATH for the test process. Invoke the-  -- exact packaged CLI directly so each example retains its process/stdio/exit-code-  -- boundary without paying for a fresh `cabal run` planning pass.-  readProcessWithExitCode "keiro-dsl" resolved ""-  where-    resolveArgument argument-      | "test/fixtures/" `isPrefixOfString` argument = resolveTestPath argument-      | otherwise = pure argument-    isPrefixOfString prefix value = take (length prefix) value == prefix---- | The @spec@ field of a coverage report, i.e. what the report says it covers.-coverageSpecPath :: Value -> Maybe T.Text-coverageSpecPath value = case value of-  Aeson.Object fields -> case KeyMap.lookup "spec" fields of-    Just (Aeson.String path) -> Just path-    _ -> Nothing-  _ -> Nothing--decodeJsonValue :: FilePath -> IO Value-decodeJsonValue path = do-  decoded <- Aeson.eitherDecodeFileStrict path-  case decoded of-    Left err -> expectationFailure (path <> ": " <> err) >> fail "unreachable"-    Right value -> pure value--jsonField :: T.Text -> Value -> Maybe Value-jsonField name = \case-  Aeson.Object fields -> KeyMap.lookup (Key.fromText name) fields-  _ -> Nothing---- | Order-preserving deduplication for comparing cited file sets.-nubOrd :: (Eq a) => [a] -> [a]-nubOrd = go []-  where-    go seen [] = reverse seen-    go seen (x : xs) = if x `elem` seen then go seen xs else go (x : seen) xs---- | Parse a workspace manifest, failing the test on a refusal.-shouldParseManifest :: FilePath -> T.Text -> IO WorkspaceManifest-shouldParseManifest path source = case parseWorkspaceManifest path source of-  Left err -> expectationFailure (T.unpack err) >> error "unreachable"-  Right manifest -> pure manifest---- | Generate a canonical workspace manifest. Members are drawn from a pool of--- paths that are distinct even under case folding and are held sorted, which is--- the invariant every parsed manifest satisfies.-genWorkspaceManifest :: Gen WorkspaceManifest-genWorkspaceManifest = do-  service <- elements ["demo-project", "mori", "kotei", "a1", "svc-2"]-  runtimePackage <- elements [Nothing, Just (RuntimePackageName "demo-core"), Just (RuntimePackageName "mori2")]-  moduleRoot <- elements [Nothing, Just "Demo", Just "Demo.Modules.Project"]-  layout <- elements [Nothing, Just GeneratedPrefix, Just CollocatedLeaf]-  chosen <--    sublistOf-      [ "a.keiro",-        "d-e_f.keiro",-        "domain/b.keiro",-        "domain/sub/c.keiro",-        "x1.keiro"-      ]-      `suchThat` (not . null)-  pure-    WorkspaceManifest-      { service = service,-        serviceLoc = Loc 1,-        runtimePackage = runtimePackage,-        runtimePackageLoc = Loc 2,-        moduleRoot = moduleRoot,-        moduleRootLoc = Loc 2,-        layout = layout,-        layoutLoc = Loc 3,-        members = NE.fromList [WorkspaceMemberRef path (Loc 4) | path <- sort chosen]-      }---- | Parse a fixture while retaining its released language contract.-parsedSourceOf :: FilePath -> IO ParsedSource-parsedSourceOf path = do-  input <- readTestText path-  case parseSource path input of-    Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"-    Right parsed -> pure parsed--checkedServiceOf :: FilePath -> IO CheckedService-checkedServiceOf = fmap checkedSource . parsedSourceOf--renderFoldBaseline :: T.Text -> CheckedService -> T.Text-renderFoldBaseline fixture service =-  T.intercalate-    "\n\n"-    [ T.unlines-        ( [ "fixture=" <> fixture,-            "aggregate=" <> (.name) aggregate,-            "fingerprint=" <> aggregateFoldFingerprintForService service aggregate,-            "surface-begin"-          ]-            <> T.lines (aggregateFoldSurfaceForService service aggregate)-            <> ["surface-end"]-        )-    | NAggregate aggregate <- (.nodes) (checkedSpec service)-    ]---- | Parse a fixture through the source-aware boundary and return its graph.-specOf :: FilePath -> IO Spec-specOf = fmap checkedSpec . checkedServiceOf---- | Parse one fixture through the exact source-aware boundary and adapt it to--- one-member workspace semantics without falling back to line-only provenance.-exactOneMemberWorkspaceOf :: FilePath -> IO (WorkspaceSpec, ParsedSourceDocument)-exactOneMemberWorkspaceOf path = do-  source <- readTestText path-  document <- case parseSourceDocument path source of-    Left failure -> expectationFailure (show failure) >> fail "unreachable"-    Right value -> pure value-  workspace <--    either-      (\failure -> expectationFailure (show failure) >> fail "unreachable")-      pure-      (oneMemberParsedDocumentWorkspace path document)-  pure (workspace, document)---- | Parse a fixture and scaffold its checked semantic service.-scaffoldFixture :: FilePath -> IO [ScaffoldModule]-scaffoldFixture path = do-  service <- checkedServiceOf path-  pure (scaffoldServiceModules (defaultContext ((checkedSpec service).context)) service)--legacyScaffoldProcessFixture :: FilePath -> IO [ScaffoldModule]-legacyScaffoldProcessFixture path = do-  spec <- specOf path-  pure $ concat [scaffoldProcess (ctx spec) process | NProcess process <- (.nodes) spec]-  where-    ctx spec = defaultContext (spec.context)---- | Assert a freshly-scaffolded Generated module matches its committed copy--- under test/conformance/ (whitespace-normalized). The committed copies are the--- ones the keiro-dsl-conformance suite compiles, so this pins the live scaffolder--- to known-compiling output.-assertMatchesCommitted :: ScaffoldModule -> IO ()-assertMatchesCommitted m = do-  let committedPath = "test/conformance/" <> (.path) m-  committed <- readTestText committedPath-  normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) m)--normalizeGenerated :: T.Text -> (T.Text, [T.Text])-normalizeGenerated text =-  let (orderInsensitiveLines, body) = partition isOrderInsensitive (T.lines text)-   in (normalizeBody body, sort (map normalizeImport orderInsensitiveLines))-  where-    -- Compare the deterministic body exactly as before and imports/language-    -- pragmas as a sorted, whitespace-normalized list. Sorting tolerates-    -- formatter reordering while additions, removals, and renamed entries still-    -- fail the pin.-    isOrderInsensitive line = isImport line || "{-# LANGUAGE " `T.isPrefixOf` line-    normalizeBody =-      -- Fourmolu parenthesizes a single class constraint while the emitter's-      -- compact spelling remains valid Haskell.  Treat that formatter-only-      -- rewrite like the whitespace and comma placement normalized below.-      T.replace "(Show value) =>" "Show value =>"-        . T.replace "( " "("-        . T.replace " )" ")"-        . T.replace " , )" " )"-        . T.unwords-        . T.words-        . T.replace "}" " } "-        . T.replace "{" " { "-        . T.replace "]" " ] "-        . T.replace "[" " [ "-        . T.replace "," " , "-        . T.unlines-        . map normalizeBanner-    normalizeBanner line-      | isGeneratedBannerLine line = generatedBanner-      | otherwise = line-    normalizeImport line =-      let reordered = case T.words line of-            "import" : "qualified" : moduleName : rest -> T.unwords ("import" : moduleName : "qualified" : rest)-            wordsInImport -> T.unwords wordsInImport-          (prefix, explicit) = T.breakOn " (" reordered-       in if T.null explicit-            then prefix-            else-              let members =-                    sort-                      . map (T.replace " (" "(" . T.unwords . T.words)-                      . T.splitOn ","-                      . T.dropEnd 1-                      $ T.drop 2 explicit-               in prefix <> " (" <> T.intercalate "," members <> ")"-    isImport line = case T.words line of-      "import" : _ -> True-      _ -> False---- | Locate and read a test fixture or committed conformance source regardless--- of whether the suite was launched from the package directory or repo root.-readTestText :: FilePath -> IO T.Text-readTestText path = resolveTestPath path >>= TIO.readFile--assertMatchesGolden :: FilePath -> T.Text -> IO ()-assertMatchesGolden path actual = do-  resolved <- resolveTestPath path-  update <- lookupEnv "KEIRO_DSL_UPDATE_GOLDENS"-  if update == Just "1"-    then TIO.writeFile resolved (T.stripEnd actual <> "\n")-    else do-      golden <- TIO.readFile resolved-      T.stripEnd actual `shouldBe` T.stripEnd golden---- | Assert an exact serialized contract, including its final-newline policy.-assertMatchesByteGolden :: FilePath -> BS.ByteString -> IO ()-assertMatchesByteGolden path actual = do-  resolved <- resolveTestPath path-  update <- lookupEnv "KEIRO_DSL_UPDATE_GOLDENS"-  if update == Just "1"-    then BS.writeFile resolved actual-    else BS.readFile resolved >>= (`shouldBe` actual)---- | Locate a repo file regardless of the test process's current directory.-resolveTestPath :: FilePath -> IO FilePath-resolveTestPath rel = do-  override <- lookupEnv "KEIRO_DSL_TEST_ROOT"-  let candidates = [rel, "keiro-dsl" </> rel] <> maybe [] (\root -> [root </> rel]) override-  existing <- filterM doesFileExist candidates-  case existing of-    path : _ -> pure path-    [] ->-      fail $-        "unable to locate keiro-dsl test file "-          <> show rel-          <> "; tried "-          <> show candidates--leftContains :: T.Text -> Either T.Text a -> Bool-leftContains needle = \case-  Left err -> needle `T.isInfixOf` err-  Right _ -> False--mappedConsumerSurfaceSource :: IO T.Text-mappedConsumerSurfaceSource = do-  base <- readTestText "test/fixtures/consumer-types.keiro"-  pure $-    T.replace "language keiro-dsl 4" "language keiro-dsl 5" base-      <> T.unlines-        [ "",-          "workqueue ArtifactJobs {",-          "  queue logical = \"artifact-jobs\"",-          "  derive physical = \"artifact-jobs\"",-          "    dlq = \"artifact-jobs_dlq\"",-          "    table = \"q_artifact-jobs\"",-          "  payload ArtifactJob {",-          "    jobData -> \"payload\" : List (Optional ArtifactInfo)",-          "  }",-          "  retry maxRetries = 3 delay = 1s dlq = on",-          "  disposition {",-          "    storeFailure -> retry 1s",-          "    commandRejected -> ackOk",-          "    decodeFailure -> deadLetter",-          "    onCodecReject -> deadLetter",-          "  }",-          "}",-          "",-          "readmodel ArtifactLookup {",-          "  table = \"artifact_lookup\"",-          "  schema = \"public\"",-          "  columns {}",-          "  query input = ArtifactInfo",-          "  query result = Optional ArtifactLocation",-          "  version = 1",-          "  shape = \"fixture\"",-          "  freshness = immediate",-          "}"-        ]--changeProjectionMappedWire :: MappedDecl -> MappedDecl-changeProjectionMappedWire declaration@MappedOpaque {moCodecVersion = version} =-  declaration {moCodecVersion = fmap (<> "-changed") version}-changeProjectionMappedWire declaration@MappedStructural {msShape = ShapeUnion encoding arms} =-  declaration-    { msShape =-        ShapeUnion-          encoding-          ( case arms of-              [] -> []-              arm : remaining -> wireArmWithTag (arm.tag <> "-changed") arm : remaining-          )-    }-changeProjectionMappedWire declaration = declaration--projectionEventWithoutGeometry :: Spec -> Spec-projectionEventWithoutGeometry candidate =-  specWithNodes (map stripGeometry candidate.nodes) candidate-  where-    stripGeometry (NAggregate aggregate) =-      let artifactFields =-            [ field-            | command <- (.commands) aggregate,-              (.name) command == "ObserveArtifact",-              field <- (.fields) command,-              (.name) field == "artifact"-            ]-       in NAggregate-            aggregate-              { regs = filter ((/= "currentGeometry") . (.name)) ((.regs) aggregate),-                events = map (explicitArtifactEvent artifactFields) ((.events) aggregate),-                transitions = map stripGeometryWrite ((.transitions) aggregate)-              }-    stripGeometry node = node-    explicitArtifactEvent artifactFields event@Event {body = EventFromCommand commandName}-      | commandName == "ObserveArtifact" =-          eventWithBody (EventFields artifactFields) event-    explicitArtifactEvent _ event = event-    stripGeometryWrite transition = transition {writes = filter ((/= "currentGeometry") . fst) ((.writes) transition)}--parseInlineSpec :: FilePath -> T.Text -> IO Spec-parseInlineSpec sourceName src = case parseSpec sourceName src of-  Left err -> expectationFailure (T.unpack err) >> error "unreachable"-  Right spec -> pure spec--checkedServiceFromText :: FilePath -> T.Text -> IO CheckedService-checkedServiceFromText sourceName src = case parseSource sourceName src of-  Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> error "unreachable"-  Right parsed -> pure (checkedSource parsed)--parseStableRenderedSpec :: FilePath -> Spec -> Either T.Text Spec-parseStableRenderedSpec sourceName spec =-  case parseSource sourceName stableSource of-    Left failure -> Left (renderParseFailure failure)-    Right parsed -> Right (parsed.spec)-  where-    stableSource =-      "language keiro-dsl "-        <> T.pack (show (languageVersionNumber currentStableLanguageVersion))-        <> "\n"-        <> renderSpec spec--parseLanguage4RenderedSpec :: FilePath -> Spec -> Either T.Text Spec-parseLanguage4RenderedSpec sourceName spec =-  case parseSource sourceName language4Source of-    Left failure -> Left (renderParseFailure failure)-    Right parsed -> Right (parsed.spec)-  where-    language4Source = "language keiro-dsl 4\n" <> renderSpec spec--shouldParseStableRenderedSpec :: FilePath -> Spec -> IO Spec-shouldParseStableRenderedSpec sourceName spec =-  case parseStableRenderedSpec sourceName spec of-    Left failure -> expectationFailure (T.unpack failure) >> fail "unreachable"-    Right reparsed -> pure reparsed--shouldResolveTypeGraph :: Spec -> IO TypeGraph-shouldResolveTypeGraph spec = case resolveTypeGraph spec of-  Left errors -> expectationFailure ("type graph failed: " <> show errors) >> error "unreachable"-  Right graph -> pure graph--shouldResolveCoverage :: FilePath -> Spec -> IO Coverage.CoverageReport-shouldResolveCoverage path spec = case Coverage.coverageReport path spec of-  Left errors -> expectationFailure ("coverage graph failed: " <> show errors) >> error "unreachable"-  Right report -> pure report--withoutVendorGeometry :: Spec -> Spec-withoutVendorGeometry spec =-  spec-    { mapped = filter (not . isVendorGeometry) ((.mapped) spec),-      nodes = map stripNode ((.nodes) spec)-    }-  where-    isVendorGeometry MappedOpaque {moName = "VendorGeometry"} = True-    isVendorGeometry _ = False-    stripNode (NAggregate aggregate) =-      NAggregate-        aggregate-          { regs = filter ((/= TRef "VendorGeometry") . (.valueType)) ((.regs) aggregate),-            commands = map stripCommand ((.commands) aggregate),-            events = map stripEvent ((.events) aggregate)-          }-    stripNode node = node-    stripCommand command = commandWithFields (filter ((/= Just (TRef "VendorGeometry")) . (.valueType)) command.fields) command-    stripEvent event = eventWithBody (case event.body of EventFields fields -> EventFields (filter ((/= Just (TRef "VendorGeometry")) . (.valueType)) fields); body -> body) event--withMetadataJson :: Spec -> Spec-withMetadataJson spec = spec {mapped = map updateDeclaration ((.mapped) spec)}-  where-    updateDeclaration declaration@MappedStructural {msName = "ArtifactMetadata", msShape = ShapeRecord constructor unknownFields fields} =-      declaration-        { msShape =-            ShapeRecord-              constructor-              unknownFields-              [if field.haskell == "note" then wireFieldWithValueType TJson field else field | field <- fields]-        }-    updateDeclaration declaration = declaration--expressionTags :: TypeExprAlgebra [T.Text]-expressionTags =-  TypeExprAlgebra-    { onText = ["text"],-      onInt = ["int"],-      onInteger = ["integer"],-      onBool = ["bool"],-      onNatural = ["natural"],-      onTime = ["time"],-      onJson = ["json"],-      onOptional = ("optional" :),-      onList = ("list" :),-      onMap = ("map" :),-      onRef = \key -> ["ref:" <> unMappedKey key]-    }--hasTypeGraphError :: (TypeGraphError -> Bool) -> Either (NonEmpty TypeGraphError) TypeGraph -> Bool-hasTypeGraphError predicate = \case-  Left errors -> any predicate errors-  Right _ -> False--isRecursive :: TypeGraphError -> Bool-isRecursive TGRecursive {} = True-isRecursive _ = False--isUnresolved :: TypeGraphError -> Bool-isUnresolved TGUnresolvedRef {} = True-isUnresolved _ = False--mappedSpec :: [MappedDecl] -> Spec-mappedSpec declarations = Spec "mapped-test" Nothing Nothing [] [] [] [] declarations []--completeStructural :: Name -> MappedShape -> MappedDecl-completeStructural name shape =-  MappedStructural-    { msName = name,-      msHaskell = Just (HaskellSource "mapped-test" "Example.Mapped" name),-      msBinding = Just ("Example.Mapped." <> T.toLower name <> "Binding"),-      msBindingVersion = Just "1",-      msCanonical = Just ("example.mapped." <> name),-      msFixtures = Just ("Example.Mapped." <> T.toLower name <> "Cases"),-      msInitial = Nothing,-      msShape = shape,-      msLoc = noLoc-    }--recordShape :: [TypeExpr] -> MappedShape-recordShape types =-  ShapeRecord-    "MappedRecord"-    RejectUnknown-    [ WireField-        { haskell = "field" <> T.pack (show index),-          key = "field" <> T.pack (show index),-          valueType = valueType,-          presence = PRequired,-          onMissing = Nothing,-          loc = noLoc-        }-    | (index, valueType) <- zip [(1 :: Int) ..] types-    ]--mapArtifactField :: (WireField -> WireField) -> Spec -> Spec-mapArtifactField = mapArtifactNamedField "key"--mapArtifactNamedField :: Name -> (WireField -> WireField) -> Spec -> Spec-mapArtifactNamedField target transform spec = spec {mapped = map updateDeclaration ((.mapped) spec)}-  where-    updateDeclaration declaration@MappedStructural {msName = "ArtifactInfo", msShape = ShapeRecord constructor unknownFields fields} =-      declaration-        { msShape =-            ShapeRecord-              constructor-              unknownFields-              [if (.haskell) field == target then transform field else field | field <- fields]-        }-    updateDeclaration declaration = declaration--mapMappedStructural :: Name -> (MappedDecl -> MappedDecl) -> Spec -> Spec-mapMappedStructural target transform spec =-  spec-    { mapped =-        [ case declaration of-            MappedStructural {msName = name}-              | name == target -> transform declaration-            _ -> declaration-        | declaration <- (.mapped) spec-        ]-    }--renameRecordConstructor :: MappedShape -> MappedShape-renameRecordConstructor (ShapeRecord _ unknownFields fields) = ShapeRecord "ArtifactInfoV2" unknownFields fields-renameRecordConstructor shape = shape--renameMappedRecordConstructor :: MappedDecl -> MappedDecl-renameMappedRecordConstructor declaration@MappedStructural {msShape = shape} =-  declaration {msShape = renameRecordConstructor shape}-renameMappedRecordConstructor declaration = declaration--changeMappedCanonical :: MappedDecl -> MappedDecl-changeMappedCanonical declaration@MappedStructural {} =-  declaration {msCanonical = Just "example.artifact.ArtifactInfo.v2"}-changeMappedCanonical declaration = declaration--data MappedMutation = MappedMutation-  { mmCandidate :: !Spec,-    mmCode :: !DiagnosticCode,-    mmExpectedSubjects :: !(Set.Set T.Text)-  }-  deriving stock (Show)--mappedWireMutations :: Spec -> [MappedMutation]-mappedWireMutations spec = case resolveTypeGraph spec of-  Left _ -> []-  Right graph -> concatMap (uncurry (declarationMutations graph)) (zip [0 :: Int ..] ((.mapped) spec))-  where-    declarationMutations graph declarationIndex declaration = case declaration of-      MappedStructural {msName = declarationName, msShape = shape} -> case shape of-        ShapeRecord _ _ fields ->-          concat-            [ [ mutation-                  graph-                  declarationName-                  MappedWireKeyChanged-                  (fieldSubject (wireFieldWithKey (field.key <> "__mutated") field))-                  (mutateRecordField declarationIndex fieldIndex (\value -> wireFieldWithKey (value.key <> "__mutated") value) spec),-                mutation-                  graph-                  declarationName-                  MappedPresenceChanged-                  (fieldSubject field)-                  (mutateRecordField declarationIndex fieldIndex (\value -> wireFieldWithPresence (flipPresence value.presence) value) spec)-              ]-                <> [ mutation-                       graph-                       declarationName-                       defaultCode-                       (fieldSubject field)-                       (mutateRecordField declarationIndex fieldIndex (wireFieldWithOnMissing changedDefault) spec)-                   | oldDefault <- maybeToListTest ((.onMissing) field),-                     let (changedDefault, defaultCode) = mutateDefault oldDefault-                   ]-            | (fieldIndex, field) <- zip [0 :: Int ..] fields-            ]-        ShapeEnum entries ->-          [ mutation-              graph-              declarationName-              MappedEnumSpellingChanged-              (enumSubject (wireEnumWithTag (entry.tag <> "__mutated") entry))-              (mutateEnumEntry declarationIndex entryIndex (\value -> wireEnumWithTag (value.tag <> "__mutated") value) spec)-          | (entryIndex, entry) <- zip [0 :: Int ..] entries-          ]-        ShapeUnion _ arms ->-          [ mutation-              graph-              declarationName-              MappedArmTagChanged-              (armSubject (wireArmWithTag (arm.tag <> "__mutated") arm))-              (mutateUnionArm declarationIndex armIndex (\value -> wireArmWithTag (value.tag <> "__mutated") value) spec)-          | (armIndex, arm) <- zip [0 :: Int ..] arms-          ]-      MappedOpaque {moName = declarationName, moCodecVersion = version} ->-        [ mutation-            graph-            declarationName-            MappedOpaqueCodecChanged-            "codec"-            ( updateMappedAt-                declarationIndex-                ( \case-                    value@MappedOpaque {} -> value {moCodecVersion = fmap (<> "__mutated") version}-                    value -> value-                )-                spec-            )-        ]--    mutation graph declarationName diagnosticCode leaf candidate =-      MappedMutation-        { mmCandidate = candidate,-          mmCode = diagnosticCode,-          mmExpectedSubjects =-            Set.fromList-              [ renderUsePath path <> " " <> leaf-              | path <- usePaths graph declarationName-              ]-        }--fieldSubject :: WireField -> T.Text-fieldSubject field = ".field " <> (.haskell) field <> "[\"" <> (.key) field <> "\"]"--enumSubject :: WireEnum -> T.Text-enumSubject entry = ".enum " <> (.ctor) entry <> "[\"" <> (.tag) entry <> "\"]"--armSubject :: WireArm -> T.Text-armSubject arm = ".arm " <> (.ctor) arm <> "[\"" <> (.tag) arm <> "\"]"--flipPresence :: Presence -> Presence-flipPresence PRequired = POptional-flipPresence POptional = PRequired--mutateDefault :: OnMissing -> (Maybe OnMissing, DiagnosticCode)-mutateDefault = \case-  OmNull -> (Nothing, MappedDefaultRemoved)-  OmText value -> (Just (OmText (value <> "__mutated")), MappedDefaultChanged)-  OmInt value -> (Just (OmInt (value + 1)), MappedDefaultChanged)-  OmBool value -> (Just (OmBool (not value)), MappedDefaultChanged)-  OmEmptyList -> (Nothing, MappedDefaultRemoved)-  OmEmptyMap -> (Nothing, MappedDefaultRemoved)-  OmCtor constructor -> (Just (OmCtor (constructor <> "Mutated")), MappedDefaultChanged)--mutateRecordField :: Int -> Int -> (WireField -> WireField) -> Spec -> Spec-mutateRecordField declarationIndex fieldIndex transform =-  updateMappedAt declarationIndex $ \case-    declaration@MappedStructural {msShape = ShapeRecord constructor unknownFields fields} ->-      declaration {msShape = ShapeRecord constructor unknownFields (updateAt fieldIndex transform fields)}-    declaration -> declaration--mutateEnumEntry :: Int -> Int -> (WireEnum -> WireEnum) -> Spec -> Spec-mutateEnumEntry declarationIndex entryIndex transform =-  updateMappedAt declarationIndex $ \case-    declaration@MappedStructural {msShape = ShapeEnum entries} ->-      declaration {msShape = ShapeEnum (updateAt entryIndex transform entries)}-    declaration -> declaration--mutateUnionArm :: Int -> Int -> (WireArm -> WireArm) -> Spec -> Spec-mutateUnionArm declarationIndex armIndex transform =-  updateMappedAt declarationIndex $ \case-    declaration@MappedStructural {msShape = ShapeUnion encoding arms} ->-      declaration {msShape = ShapeUnion encoding (updateAt armIndex transform arms)}-    declaration -> declaration--updateMappedAt :: Int -> (MappedDecl -> MappedDecl) -> Spec -> Spec-updateMappedAt declarationIndex transform spec =-  spec {mapped = updateAt declarationIndex transform ((.mapped) spec)}--updateAt :: Int -> (a -> a) -> [a] -> [a]-updateAt target transform values =-  [if index == target then transform value else value | (index, value) <- zip [0 :: Int ..] values]--maybeToListTest :: Maybe a -> [a]-maybeToListTest = maybe [] pure--isAdditiveChange :: Change -> Bool-isAdditiveChange Additive {} = True-isAdditiveChange Advisory {} = False-isAdditiveChange Breaking {} = False--mappedIngredientMutations :: Spec -> [(Spec, DiagnosticCode)]-mappedIngredientMutations spec =-  [ (mapMappedStructural "ArtifactInfo" clearStructuralHaskell spec, MappedMissingIngredient),-    (mapMappedStructural "ArtifactInfo" clearStructuralBinding spec, MappedMissingIngredient),-    (mapMappedStructural "ArtifactInfo" clearStructuralBindingVersion spec, MappedMissingIngredient),-    (mapMappedStructural "ArtifactInfo" clearStructuralCanonical spec, MappedMissingIngredient),-    (mapMappedStructural "ArtifactInfo" clearStructuralFixtures spec, MappedMissingIngredient),-    (mapMappedStructural "ArtifactInfo" clearStructuralInitial spec, MappedMissingInitialValue),-    (mapMappedDeclaration "VendorGeometry" clearOpaqueHaskell spec, MappedMissingIngredient),-    (mapMappedDeclaration "VendorGeometry" clearOpaqueCodec spec, MappedMissingIngredient),-    (mapMappedDeclaration "VendorGeometry" clearOpaqueCodecVersion spec, MappedMissingIngredient),-    (mapMappedDeclaration "VendorGeometry" clearOpaqueFixtures spec, MappedMissingIngredient)-  ]-  where-    clearStructuralHaskell declaration@MappedStructural {} = declaration {msHaskell = Nothing}-    clearStructuralHaskell declaration = declaration-    clearStructuralBinding declaration@MappedStructural {} = declaration {msBinding = Nothing}-    clearStructuralBinding declaration = declaration-    clearStructuralBindingVersion declaration@MappedStructural {} = declaration {msBindingVersion = Nothing}-    clearStructuralBindingVersion declaration = declaration-    clearStructuralCanonical declaration@MappedStructural {} = declaration {msCanonical = Nothing}-    clearStructuralCanonical declaration = declaration-    clearStructuralFixtures declaration@MappedStructural {} = declaration {msFixtures = Nothing}-    clearStructuralFixtures declaration = declaration-    clearStructuralInitial declaration@MappedStructural {} = declaration {msInitial = Nothing}-    clearStructuralInitial declaration = declaration-    clearOpaqueHaskell declaration@MappedOpaque {} = declaration {moHaskell = Nothing}-    clearOpaqueHaskell declaration = declaration-    clearOpaqueCodec declaration@MappedOpaque {} = declaration {moCodecId = Nothing}-    clearOpaqueCodec declaration = declaration-    clearOpaqueCodecVersion declaration@MappedOpaque {} = declaration {moCodecVersion = Nothing}-    clearOpaqueCodecVersion declaration = declaration-    clearOpaqueFixtures declaration@MappedOpaque {} = declaration {moFixtures = Nothing}-    clearOpaqueFixtures declaration = declaration--mapMappedDeclaration :: Name -> (MappedDecl -> MappedDecl) -> Spec -> Spec-mapMappedDeclaration target transform spec =-  spec-    { mapped =-        [ if mappedDeclarationName declaration == target then transform declaration else declaration-        | declaration <- (.mapped) spec-        ]-    }--mappedDeclarationName :: MappedDecl -> Name-mappedDeclarationName MappedStructural {msName = name} = name-mappedDeclarationName MappedOpaque {moName = name} = name--statusMapSpec :: T.Text -> T.Text-statusMapSpec marker =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "  states Open",-      "",-      "  event Created { }",-      "  event Changed { }",-      "",-      "  projection things consistency=Eventual key=thingId",-      "    status-map" <> marker <> " { Created=>held }"-    ]--parseErrorOf :: FilePath -> T.Text -> IO T.Text-parseErrorOf sourceName src = case parseSpec sourceName src of-  Left err -> pure err-  Right _ -> expectationFailure ("expected parse failure for " <> sourceName) >> error "unreachable"--duplicateGotoSpec :: T.Text-duplicateGotoSpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "  states A B C",-      "",-      "  command Go { }",-      "  A -- Go -->",-      "    goto B",-      "    goto C"-    ]--missingGotoSpec :: T.Text-missingGotoSpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "  states A B",-      "",-      "  command Go { }",-      "  A -- Go -->",-      "    emit Changed"-    ]--duplicateWireSpec :: T.Text-duplicateWireSpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "  states Open",-      "",-      "  wire kind=ctorName fields=camelCase schemaVersion=1",-      "  wire kind=typeName fields=snakeCase schemaVersion=2"-    ]--duplicateProjectionSpec :: T.Text-duplicateProjectionSpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "  states Open",-      "",-      "  projection first consistency=Strong key=thingId",-      "    status-map partial { }",-      "  projection second consistency=Eventual key=thingId"-    ]--projectionWithoutConsistencySpec :: T.Text-projectionWithoutConsistencySpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "  states Open",-      "",-      "  projection things key=thingId"-    ]--malformedRegisterSpec :: T.Text-malformedRegisterSpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "    status Status",-      "  states Open"-    ]--misplacedDispatchIdSpec :: T.Text-misplacedDispatchIdSpec =-  T.replace-    "    schedule timer\n\n  dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)\n"-    "    dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)\n    schedule timer\n"-    (renderSpec (Spec "svc" Nothing Nothing [] [] [] [] [] [NProcess (processWithLiteral "literal")]))--lineNumberContaining :: T.Text -> T.Text -> Int-lineNumberContaining needle = go 1 . T.lines-  where-    go current = \case-      [] -> current-      lineText : rest-        | needle `T.isInfixOf` lineText -> current-        | otherwise -> go (current + 1) rest--decimalOverflow :: T.Text-decimalOverflow = "18446744073709551617"--decimalOverflowSpecs :: [(String, T.Text)]-decimalOverflowSpecs =-  [ ("event-version", eventVersionDecimalSpec decimalOverflow),-    ("wire-schema", wireDecimalSpec decimalOverflow),-    ("contract-schema", contractDecimalSpec decimalOverflow),-    ("decode-schema", decodeDecimalSpec decimalOverflow),-    ("publisher-attempts", publisherDecimalSpec decimalOverflow),-    ("workqueue-retries", workqueueDecimalSpec decimalOverflow),-    ("timer-attempts", timerDecimalSpec decimalOverflow)-  ]--eventVersionDecimalSpec :: T.Text -> T.Text-eventVersionDecimalSpec value =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "  states Open",-      "",-      "  event Changed v" <> value <> " { }"-    ]--wireDecimalSpec :: T.Text -> T.Text-wireDecimalSpec value =-  T.unlines-    [ "context svc",-      "",-      "aggregate Thing",-      "  regs",-      "  states Open",-      "",-      "  wire kind=ctorName fields=camelCase schemaVersion=" <> value-    ]--contractDecimalSpec :: T.Text -> T.Text-contractDecimalSpec value =-  T.unlines-    [ "context svc",-      "",-      "contract Contract {",-      "  schemaVersion " <> value,-      "  discriminator kind",-      "}"-    ]--decodeDecimalSpec :: T.Text -> T.Text-decodeDecimalSpec value =-  T.unlines-    [ "context svc",-      "",-      "intake Inbox {",-      "  contract Contract",-      "  topic events",-      "  accept Event",-      "  dedupe key messageId policy PreferIntegrationMessageId",-      "  decode { envelope strict-required lenient-optional body strict schemaVersion == " <> value <> " }",-      "  disposition { }",-      "}"-    ]--publisherDecimalSpec :: T.Text -> T.Text-publisherDecimalSpec value =-  T.unlines-    [ "context svc",-      "",-      "publisher Publisher {",-      "  emit Emit",-      "  ordering PerKeyHeadOfLine",-      "  maxAttempts " <> value,-      "  backoff constant 2s",-      "  outboxId stable from messageId",-      "}"-    ]--workqueueDecimalSpec :: T.Text -> T.Text-workqueueDecimalSpec value =-  T.unlines-    [ "context svc",-      "",-      "workqueue Queue {",-      "  queue logical = \"queue\"",-      "  derive physical = \"queue\"",-      "    dlq = \"queue_dlq\"",-      "    table = \"pgmq.q_queue\"",-      "  payload Job { }",-      "  retry maxRetries = " <> value <> " delay = 5s dlq = on",-      "  disposition { }",-      "}"-    ]--timerDecimalSpec :: T.Text -> T.Text-timerDecimalSpec value =-  T.replace-    "max-attempts 5"-    ("max-attempts " <> value)-    (renderSpec (Spec "svc" Nothing Nothing [] [] [] [] [] [NProcess (processWithLiteral "literal")]))--identifierHygieneSpec :: T.Text-identifierHygieneSpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate thing",-      "  regs",-      "  states Open",-      "",-      "  command DoIt { data }"-    ]--vertexCollisionSpec :: T.Text-vertexCollisionSpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate Reservation",-      "  regs",-      "  states Created",-      "",-      "  event ReservationCreated { }"-    ]--underscoreNodeSpec :: T.Text-underscoreNodeSpec =-  T.unlines-    [ "context svc",-      "",-      "contract _contract {",-      "  schemaVersion 1",-      "  discriminator kind",-      "}"-    ]--normalizedCollisionSpec :: T.Text-normalizedCollisionSpec =-  T.unlines-    [ "context svc",-      "",-      "contract fooBar {",-      "  schemaVersion 1",-      "  discriminator kind",-      "}",-      "",-      "contract foo_bar {",-      "  schemaVersion 1",-      "  discriminator kind",-      "}"-    ]--unicodeIdentifierSpec :: T.Text-unicodeIdentifierSpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate Résumé",-      "  regs",-      "  states Open"-    ]--emptyStatesSpec :: Spec-emptyStatesSpec =-  Spec-    "svc"-    Nothing-    Nothing-    []-    []-    []-    []-    []-    [NAggregate (Aggregate "Thing" [] [] [] [] [] Nothing [] Nothing Nothing Nothing noLoc)]--crossFamilyBoundarySpec :: T.Text-crossFamilyBoundarySpec =-  T.unlines-    [ "context svc",-      "",-      "aggregate First",-      "  regs",-      "  states A B",-      "  command Go { }",-      "  A -- Go -->",-      "    emit Changed",-      "    goto B",-      "",-      "emit Output {",-      "  contract Contract",-      "  topic events",-      "  source \"source\"",-      "  key thingId",-      "  map status { _ => skip }",-      "  messageId derive hole",-      "  idempotencyKey derive hole",-      "}",-      "",-      "aggregate Second",-      "  regs",-      "  states",-      "",-      "dispatch QueueDispatch {",-      "  source readModel = source key = thingId",-      "  fanout body = resolveFanout",-      "  dedup key = thingId",-      "    seenIn readModel = seen field = thingId",-      "    seenIn queue = workQueue field = thingId",-      "  enqueue to = workQueue",-      "}"-    ]------------------------------------------------------------------------------------- Generators (bounded; restricted to valid, non-reserved identifiers)------------------------------------------------------------------------------------- | Text that exercises every supported escape plus notation punctuation that--- used to be able to split one emit-map row into several rows.-genAdversarialText :: Gen T.Text-genAdversarialText =-  T.concat-    <$> resize-      20-      (listOf (elements ["a", "Z", "\"", "\\", "\n", "\t", "\r", "=>", "#", "{", "}", " "]))---- | One spec carrying the same adversarial value through three distinct--- printer paths: a contract topic, an emit-map value, and a quote-wrapped--- field-binding literal.-escapedSpec :: T.Text -> Spec-escapedSpec value =-  Spec-    "escape"-    Nothing-    Nothing-    []-    []-    []-    []-    []-    [ NContract-        ContractNode-          { name = "Contract",-            schemaVersion = 1,-            discriminator = "kind",-            topics = [("events", value)],-            events = [],-            loc = noLoc-          },-      NEmit-        EmitNode-          { name = "Emit",-            contract = "Contract",-            topic = "events",-            source = "source",-            key = "key",-            discriminant = "status",-            map = [EmitMapRow value "Event" noLoc],-            skip = True,-            messageId = DeriveSpec Nothing,-            idempotencyKey = DeriveSpec Nothing,-            loc = noLoc-          },-      NProcess (processWithLiteral value)-    ]--processWithLiteral :: T.Text -> ProcessNode-processWithLiteral value =-  ProcessNode-    { id = "Process",-      name = "process",-      input = InputDecl "Input" [] Nothing noLoc,-      correlate = CorrelateDecl "key" "idText",-      saga = SagaRef "Saga" "saga",-      target = "Target",-      projections = [],-      handle =-        HandleNode-          { on = "Input",-            advance = AdvanceNode "Advance" [FieldBinding "literal" (Just ("\"" <> value <> "\""))],-            dispatch = [],-            schedule = "timer"-          },-      rejected = PolHalt,-      poison = PolHalt,-      timer =-        TimerNode-          { name = "timer",-            id = IdExpr UuidV5Id "timer:" "correlationId",-            fireAt = FireAtExpr "observedAt" "5m",-            payload = [],-            fire =-              FireNode-                { target = "Target",-                  key = "correlationId",-                  command = "Fire",-                  fields = [],-                  firedEventId = IdExpr UuidV5Id "fired:" "correlationId",-                  disposition = FireDisposition OFired OFired ORetry ORetry ORetry-                },-            decodeUnknown = "Cancelled",-            maxAttempts = 5,-            deadLetter = "exhausted",-            loc = noLoc-          },-      loc = noLoc-    }--genName :: Gen Name-genName =-  frequency-    [ ( 3,-        do-          base <- elements ["Aa", "Bb", "Cc", "Dd", "St", "Cmd", "Ev", "Reg", "Fld", "Foo", "Bar", "Qux"]-          n <- choose (0, 9 :: Int)-          pure (T.pack (base <> show n))-      ),-      (1, elements ["data1", "typeA", "whereX", "gotoX", "guardY", "emitZ", "_lead"])-    ]--genWire :: Gen T.Text-genWire = do-  base <- elements ["red", "blue", "green", "ctorName", "camelCase", "rsv", "hosp", "held", "partial-divert", "1st"]-  n <- choose (0, 9 :: Int)-  pure (T.pack (base <> show n))--genWireWord :: Gen T.Text-genWireWord = genWire--smallList :: Gen a -> Gen [a]-smallList g = choose (0, 3 :: Int) >>= \n -> vectorOf n g--nonEmptyList :: Gen a -> Gen [a]-nonEmptyList g = choose (1, 3 :: Int) >>= \n -> vectorOf n g--genMaybe :: Gen a -> Gen (Maybe a)-genMaybe g = oneof [pure Nothing, Just <$> g]--genCmp :: Gen CmpOp-genCmp = elements [OpEq, OpNeq, OpLt, OpLe, OpGt, OpGe]--genAtom :: Gen Expr-genAtom = EAtom <$> oneof [AName <$> genName, ABool <$> arbitrary]--genExpr :: Gen Expr-genExpr = go (3 :: Int)-  where-    go 0 = genAtom-    go d =-      oneof-        [ genAtom,-          EOr <$> go (d - 1) <*> go (d - 1),-          EAnd <$> go (d - 1) <*> go (d - 1),-          ECmp <$> genCmp <*> go (d - 1) <*> go (d - 1)-        ]--genField :: Gen Field-genField = Field <$> genName <*> oneof [pure Nothing, Just <$> genName]--genAggregateField :: Gen AggregateField-genAggregateField = AggregateField <$> genName <*> pure Nothing <*> pure Nothing <*> genMaybe (genTypeExpr []) <*> pure noLoc--genReg :: Gen RegDecl-genReg = RegDecl <$> genName <*> genTypeExpr [] <*> genRegInitial <*> pure noLoc--genRegInitial :: Gen RegInitial-genRegInitial = oneof [RegInitBare <$> genName, RegInitText <$> genAdversarialText]--genState :: Gen StateDecl-genState = StateDecl <$> genName <*> arbitrary <*> pure noLoc--genCommand :: Gen Command-genCommand = Command <$> genName <*> smallList genAggregateField <*> pure noLoc--genEvent :: Gen Event-genEvent = do-  name <- genName-  eventBody <- body-  version <- choose (1, 3)-  upcast <- genMaybe ((,) <$> choose (0, 3) <*> pure Hole)-  (retiring, deprecated) <- elements [(False, False), (True, False), (False, True)]-  pure-    Event-      { name = name,-        body = eventBody,-        version = version,-        upcastFrom = upcast,-        retiring = retiring,-        deprecated = deprecated,-        loc = noLoc-      }-  where-    body = oneof [EventFromCommand <$> genName, EventFields <$> smallList genAggregateField]--genTransition :: Gen Transition-genTransition =-  Transition-    <$> genName-    <*> genName-    <*> pure LegacyHoleImplementation-    <*> genMaybe genExpr-    <*> smallList ((,) <$> genName <*> genExpr)-    <*> smallList genName-    <*> pure Nothing-    <*> pure []-    <*> genName-    <*> elements [TmLive, TmReplayOnly]-    <*> pure noLoc--genWireSpec :: Gen WireSpec-genWireSpec = WireSpec <$> genWire <*> genWire <*> (getNonNegative <$> arbitrary)--genProjection :: Gen ProjectionSpec-genProjection =-  ProjectionSpec-    <$> genName-    <*> genMaybe (elements [Strong, Eventual])-    <*> genName-    <*> genMaybe (Mapping <$> smallList ((,) <$> genName <*> genWire) <*> arbitrary)-    <*> pure noLoc--genAggregate :: Gen Aggregate-genAggregate =-  Aggregate-    <$> genName-    <*> smallList genReg-    <*> smallList genState-    <*> smallList genCommand-    <*> smallList genEvent-    <*> smallList genTransition-    <*> pure Nothing-    <*> pure []-    <*> genMaybe genWireSpec-    <*> genMaybe genProjection-    <*> genMaybe (SnapshotSpec <$> oneof [SnapEvery <$> choose (0, 5), pure SnapOnTerminal] <*> choose (0, 5) <*> genAdversarialText <*> pure noLoc)-    <*> pure noLoc--genDottedRef :: Gen T.Text-genDottedRef = elements ["input.id", "input.hospitalId", "timer.id", "correlationId", "payload.messageId"]--genWindow :: Gen T.Text-genWindow = elements ["0s", "5s", "2m", "1h"]--genFieldBinding :: Gen FieldBinding-genFieldBinding =-  FieldBinding-    <$> genName-    <*> oneof-      [ pure Nothing,-        Just <$> genDottedRef,-        Just . (\raw -> "\"" <> raw <> "\"") <$> genAdversarialText-      ]--genDispatchDisposition :: Gen DispatchDisposition-genDispatchDisposition = DispatchDisposition <$> genDisp <*> genDisp <*> genDisp-  where-    genDisp = oneof [pure DAckOk, pure DRetry, DDeadLetter <$> genAdversarialText]--genDispatchNode :: Gen DispatchNode-genDispatchNode =-  DispatchNode-    <$> genName-    <*> genDottedRef-    <*> genName-    <*> smallList genFieldBinding-    <*> genDispatchDisposition-    <*> pure noLoc--genFireDisposition :: Gen FireDisposition-genFireDisposition =-  FireDisposition-    <$> elements [OFired, ORetry]-    <*> elements [OFired, ORetry]-    <*> elements [OFired, ORetry]-    <*> elements [OFired, ORetry]-    <*> elements [OFired, ORetry]--genIdExpr :: Gen IdExpr-genIdExpr = IdExpr UuidV5Id <$> genAdversarialText <*> pure "correlationId"--genFireNode :: Gen FireNode-genFireNode =-  FireNode-    <$> genName-    <*> genDottedRef-    <*> genName-    <*> smallList genFieldBinding-    <*> genIdExpr-    <*> genFireDisposition--genTimerNode :: Gen TimerNode-genTimerNode =-  TimerNode-    <$> genName-    <*> genIdExpr-    <*> (FireAtExpr <$> genName <*> genWindow)-    <*> smallList genFieldBinding-    <*> genFireNode-    <*> genName-    <*> choose (0, 5)-    <*> genAdversarialText-    <*> pure noLoc--genProcess :: Gen ProcessNode-genProcess =-  ProcessNode-    <$> genName-    <*> genAdversarialText-    <*> (InputDecl <$> genName <*> smallList genField <*> pure Nothing <*> pure noLoc)-    <*> (CorrelateDecl <$> genName <*> genName)-    <*> (SagaRef <$> genName <*> genAdversarialText)-    <*> genName-    <*> smallList genName-    <*> (HandleNode <$> genName <*> (AdvanceNode <$> genName <*> smallList genFieldBinding) <*> smallList genDispatchNode <*> genName)-    <*> elements [PolHalt, PolDeadLetter, PolSkip]-    <*> elements [PolHalt, PolDeadLetter, PolSkip]-    <*> genTimerNode-    <*> pure noLoc--genResolveSource :: Gen ResolveSource-genResolveSource = oneof [ResolveReadModel <$> genName, pure ResolveHole]--genRouter :: Gen RouterNode-genRouter =-  RouterNode-    <$> genName-    <*> genAdversarialText-    <*> (InputDecl <$> genName <*> smallList genField <*> pure Nothing <*> pure noLoc)-    <*> (CorrelateDecl <$> genName <*> genName)-    <*> (ResolveDecl <$> genResolveSource <*> smallList genName <*> pure noLoc)-    <*> genName-    <*> smallList genName-    <*> (RouterDispatchNode <$> genName <*> smallList genFieldBinding <*> genDispatchDisposition <*> pure noLoc)-    <*> elements [PolHalt, PolDeadLetter, PolSkip]-    <*> elements [PolHalt, PolDeadLetter, PolSkip]-    <*> pure noLoc--genContractField :: Gen ContractField-genContractField = ContractField <$> genName <*> pure Nothing <*> pure Nothing <*> oneof [CTypeId <$> genAdversarialText, pure CText, pure CInt] <*> pure noLoc--genContractEvent :: Gen ContractEvent-genContractEvent = ContractEvent <$> genName <*> genName <*> smallList genContractField--genContract :: Gen ContractNode-genContract =-  ContractNode-    <$> genName-    <*> choose (0, 5)-    <*> genName-    <*> smallList ((,) <$> genName <*> genAdversarialText)-    <*> smallList genContractEvent-    <*> pure noLoc--genWireSource :: Gen WireSource-genWireSource = oneof [SrcHeader <$> genAdversarialText, pure SrcBody, pure SrcKafkaKey, pure SrcKafkaCursor]--genInboxAction :: Gen InboxAction-genInboxAction = oneof [pure IAckOk, IRetry <$> genWindow, IDeadLetter <$> genMaybe genAdversarialText]--genDispositionRow :: Gen DispositionRow-genDispositionRow = DispositionRow <$> genName <*> genInboxAction <*> pure noLoc--genDecodeSpec :: Gen DecodeSpec-genDecodeSpec =-  DecodeSpec-    <$> ((\first second -> first <> " " <> second) <$> genWireWord <*> genWireWord)-    <*> arbitrary-    <*> choose (0, 5)--genIntake :: Gen IntakeNode-genIntake =-  IntakeNode-    <$> genName-    <*> genName-    <*> genName-    <*> nonEmptyList genName-    <*> smallList (BindRow <$> genName <*> genWireSource <*> arbitrary <*> arbitrary)-    <*> genName-    <*> genName-    <*> elements [InkPersistFull, InkPersistDedupeOnly]-    <*> genDecodeSpec-    <*> smallList genDispositionRow-    <*> pure noLoc--genDeriveSpec :: Gen DeriveSpec-genDeriveSpec = DeriveSpec <$> genMaybe genAdversarialText--genEmit :: Gen EmitNode-genEmit =-  EmitNode-    <$> genName-    <*> genName-    <*> genName-    <*> genAdversarialText-    <*> genName-    <*> genName-    <*> smallList (EmitMapRow <$> genAdversarialText <*> genName <*> pure noLoc)-    <*> arbitrary-    <*> genDeriveSpec-    <*> genDeriveSpec-    <*> pure noLoc--genPublisher :: Gen PublisherNode-genPublisher =-  PublisherNode-    <$> genName-    <*> genName-    <*> genName-    <*> choose (0, 5)-    <*> (BackoffSpec <$> genName <*> genWindow <*> genMaybe genWindow <*> genMaybe (elements ["1.0", "2.0", "3"]))-    <*> genName-    <*> pure noLoc--genWqField :: Gen WqField-genWqField = WqField <$> genName <*> genAdversarialText <*> (LegacyQueueScalar . QueueOther <$> genName) <*> pure noLoc--genWqDispRow :: Gen WqDispRow-genWqDispRow = WqDispRow <$> genName <*> genInboxAction <*> pure noLoc--genWorkqueue :: Gen WorkqueueNode-genWorkqueue =-  WorkqueueNode-    <$> genName-    <*> genAdversarialText-    <*> genAdversarialText-    <*> genAdversarialText-    <*> genAdversarialText-    <*> elements [WqUnordered, WqFifoThroughput, WqFifoRoundRobin]-    <*> genMaybe (WqGroupKey <$> genName <*> genName <*> genMaybe genAdversarialText)-    <*> oneof [pure WqStandard, pure WqUnlogged, WqPartitioned <$> genAdversarialText <*> genAdversarialText]-    <*> genName-    <*> smallList genWqField-    <*> choose (0, 5)-    <*> genWindow-    <*> arbitrary-    <*> smallList genWqDispRow-    <*> pure noLoc--genReadModel :: Gen ReadModelNode-genReadModel = do-  consistency <- elements [Strong, Eventual]-  scope <- genMaybe (oneof [pure RmEntireLog, RmCategory <$> genAdversarialText])-  feed <- elements [RmInline, RmSubscription]-  subscription <- genMaybe genAdversarialText-  ReadModelNode-    <$> genName-    <*> nonEmptyText-    <*> nonEmptyText-    <*> smallList (RmColumn <$> genWireWord <*> genName <*> arbitrary)-    <*> choose (0, 5)-    <*> genAdversarialText-    <*> pure (case consistency of Eventual -> FreshnessImmediate; Strong -> FreshnessWaitForHead (maybe RmEntireLog id scope))-    <*> pure (LegacyReadModelSupply consistency scope feed subscription)-    <*> pure Nothing-    <*> pure []-    <*> pure Nothing-    <*> pure Nothing-    <*> pure noLoc-  where-    nonEmptyText = genAdversarialText `suchThat` (not . T.null)--genPgmqDispatch :: Gen PgmqDispatchNode-genPgmqDispatch =-  PgmqDispatchNode-    <$> genName-    <*> genName-    <*> genName-    <*> genName-    <*> genName-    <*> genName-    <*> genName-    <*> genName-    <*> genName-    <*> genName-    <*> pure noLoc--genWfBodyItem :: Gen WfBodyItem-genWfBodyItem = sized go-  where-    go size =-      oneof $-        [ WfStep <$> genWireWord <*> genName <*> pure noLoc,-          WfAwait <$> genWireWord <*> genName <*> pure noLoc,-          WfSleep <$> genWireWord <*> genName <*> pure noLoc,-          WfChild <$> genWireWord <*> genName <*> genName <*> pure noLoc,-          WfContinueAsNew <$> genName <*> pure noLoc-        ]-          ++ [ WfPatch <$> genWireWord <*> resize (size `div` 2) (smallList genWfBodyItem) <*> pure noLoc-             | size > 0-             ]--genWorkflow :: Gen WorkflowNode-genWorkflow =-  WorkflowNode-    <$> genName-    <*> genAdversarialText-    <*> genName-    <*> smallList genField-    <*> genName-    <*> genMaybe genName-    <*> genName-    <*> smallList genWfBodyItem-    <*> pure noLoc--genOperationShape :: Gen OperationShape-genOperationShape =-  oneof-    [ CommandOp <$> genName <*> genName <*> genName <*> smallList genName,-      QueryOp <$> genName <*> genName <*> ((\parts -> T.unwords parts) <$> nonEmptyList genName) <*> genName,-      SignalOp <$> genWireWord <*> genName <*> genName <*> genName <*> genName,-      RunOp <$> genName <*> genName <*> genName-    ]--genOperation :: Gen OperationNode-genOperation = OperationNode <$> genName <*> genOperationShape <*> pure noLoc--allNodeTags :: [String]-allNodeTags = ["aggregate", "process", "router", "contract", "intake", "emit", "publisher", "workqueue", "pgmq-dispatch", "readmodel", "workflow", "operation"]--nodeTag :: Node -> String-nodeTag = \case-  NAggregate _ -> "aggregate"-  NProcess _ -> "process"-  NRouter _ -> "router"-  NContract _ -> "contract"-  NIntake _ -> "intake"-  NEmit _ -> "emit"-  NPublisher _ -> "publisher"-  NWorkqueue _ -> "workqueue"-  NPgmqDispatch _ -> "pgmq-dispatch"-  NReadModel _ -> "readmodel"-  NProjectionTarget _ -> "projection-target"-  NRebuildGroup _ -> "rebuild-group"-  NProjectionRevision _ -> "projection-revision"-  NExternalRead _ -> "external-read"-  NProjectionOwner _ -> "projection-owner"-  NWorkflow _ -> "workflow"-  NOperation _ -> "operation"--consumerNominalFor :: Name -> NominalOwnership-consumerNominalFor name =-  ConsumerNominal-    ConsumerNominalBinding-      { haskell = HaskellSource "domain" "Domain.Types" name,-        binding = QualifiedValueName "Domain.Bindings.binding",-        bindingVersion = BindingVersion "1",-        canonical = CanonicalTypeId ("domain." <> name <> ".v1"),-        fixtures = QualifiedValueName "Domain.Bindings.fixtures",-        initial = Just (QualifiedValueName "Domain.Bindings.initialValue")-      }--genId :: Gen IdDecl-genId = IdDecl <$> genName <*> genWire <*> pure Nothing <*> pure noLoc--genEnum :: Gen EnumDecl-genEnum = EnumDecl <$> genName <*> smallList ((,) <$> genName <*> genWire) <*> pure Nothing <*> pure noLoc--genRule :: Gen RuleDecl-genRule =-  RuleDecl-    <$> genName-    <*> genName-    <*> genName-    <*> nonEmptyList ((,) <$> genName <*> genExpr)-    <*> pure noLoc--genMappedDecls :: Gen [MappedDecl]-genMappedDecls = do-  count <- choose (0, 4 :: Int)-  let names = take count ["MappedA", "MappedB", "MappedC", "MappedD"]-  traverse (genMappedDecl names) names--genMappedDecl :: [Name] -> Name -> Gen MappedDecl-genMappedDecl names name =-  oneof-    [ MappedStructural name-        <$> genMaybe genHaskellSource-        <*> genMaybe genAdversarialText-        <*> genMaybe genAdversarialText-        <*> genMaybe genAdversarialText-        <*> genMaybe genAdversarialText-        <*> genMaybe genAdversarialText-        <*> genMappedShape names-        <*> pure noLoc,-      MappedOpaque name-        <$> genMaybe genHaskellSource-        <*> genMaybe genAdversarialText-        <*> genMaybe genAdversarialText-        <*> genMaybe genAdversarialText-        <*> genMaybe genAdversarialText-        <*> pure noLoc-    ]--genHaskellSource :: Gen HaskellSource-genHaskellSource =-  HaskellSource-    <$> genWire-    <*> genModuleRoot-    <*> genName--genMappedShape :: [Name] -> Gen MappedShape-genMappedShape names =-  oneof-    [ ShapeRecord-        <$> genName-        <*> elements [RejectUnknown, IgnoreUnknown]-        <*> smallList (genWireField names),-      ShapeEnum <$> smallList (WireEnum <$> genName <*> genAdversarialText <*> pure noLoc),-      ShapeUnion-        <$> (TaggedObject <$> genAdversarialText <*> genAdversarialText <*> elements [RejectUnknown, IgnoreUnknown])-        <*> smallList (WireArm <$> genName <*> genAdversarialText <*> genMaybe (genTypeExpr names) <*> pure noLoc)-    ]--genWireField :: [Name] -> Gen WireField-genWireField names =-  WireField-    <$> genName-    <*> genAdversarialText-    <*> genTypeExpr names-    <*> elements [PRequired, POptional]-    <*> genMaybe genOnMissing-    <*> pure noLoc--genTypeExpr :: [Name] -> Gen TypeExpr-genTypeExpr names = sized (go . min 3)-  where-    go 0 = base-    go depth =-      frequency-        [ (4, base),-          (1, TOptional <$> go (depth - 1)),-          (1, TList <$> go (depth - 1)),-          (1, TMap <$> go (depth - 1))-        ]-    -- This generator renders through the unversioned/version-1 grammar. Keep-    -- successor-only Integer coverage in the dedicated version-2 properties.-    base = elements ([TText, TInt, TBool, TNatural, TTime, TJson] ++ map TRef names)--genOnMissing :: Gen OnMissing-genOnMissing =-  oneof-    [ pure OmNull,-      OmText <$> genAdversarialText,-      OmInt <$> choose (-10, 10),-      OmBool <$> arbitrary,-      pure OmEmptyList,-      pure OmEmptyMap,-      OmCtor <$> genName-    ]--genSpec :: Gen Spec-genSpec = do-  name <- genWire-  moduleRoot <- genMaybe genModuleRoot-  layout <- genMaybe (elements [GeneratedPrefix, CollocatedLeaf])-  ids <- smallList genId-  enums <- smallList genEnum-  rules <- smallList genRule-  mapped <- genMappedDecls-  nodes <- smallList genNode-  pure (Spec name moduleRoot layout ids enums rules [] mapped nodes)-  where-    genNode =-      oneof-        [ NAggregate <$> genAggregate,-          NProcess <$> genProcess,-          NRouter <$> genRouter,-          NContract <$> genContract,-          NIntake <$> genIntake,-          NEmit <$> genEmit,-          NPublisher <$> genPublisher,-          NWorkqueue <$> genWorkqueue,-          NPgmqDispatch <$> genPgmqDispatch,-          NReadModel <$> genReadModel,-          NWorkflow <$> genWorkflow,-          NOperation <$> genOperation-        ]---- | A dotted PascalCase module prefix, e.g. @Acme@ or @Acme.Services@.-genModuleRoot :: Gen T.Text-genModuleRoot = do-  n <- choose (1, 3 :: Int)-  segs <- vectorOf n (elements ["Acme", "Services", "Hospital", "Domain", "Core"])-  pure (T.intercalate "." segs)--assertGeneratedHaskellContract :: T.Text -> T.Text -> Expectation-assertGeneratedHaskellContract sourceName manifest =-  take 13 (T.lines manifest)-    `shouldBe` [ "-- keiro-dsl build manifest for " <> sourceName,-                 "-- Paste the complete fragment below into the consuming Cabal stanza.",-                 "-- The generated layer is overwritten on every scaffold; hole modules are",-                 "-- create-if-absent (filled by hand).",-                 "",-                 "default-language: GHC2024",-                 "default-extensions:",-                 "    DuplicateRecordFields",-                 "    NoFieldSelectors",-                 "    OverloadedRecordDot",-                 "    OverloadedStrings",-                 "",-                 "other-modules:"-               ]--workspaceWithMembers :: [WorkspaceMember] -> WorkspaceSpec -> WorkspaceSpec-workspaceWithMembers members workspace =-  WorkspaceSpec-    { service = workspace.service,-      manifestPath = workspace.manifestPath,-      languageContract = workspace.languageContract,-      context = workspace.context,-      runtimePackage = workspace.runtimePackage,-      moduleRoot = workspace.moduleRoot,-      layout = workspace.layout,-      members = members,-      mergedSpec = workspace.mergedSpec,-      sourceIndex = workspace.sourceIndex,-      lineMap = workspace.lineMap,-      ownership = workspace.ownership-    }--specWithNodes :: [Node] -> Spec -> Spec-specWithNodes nodes (Spec contextName moduleRoot layout ids enums rules nominalScalars mapped _) =-  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes--specWithContext :: Name -> Spec -> Spec-specWithContext contextName (Spec _ moduleRoot layout ids enums rules nominalScalars mapped nodes) =-  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes--specWithMapped :: [MappedDecl] -> Spec -> Spec-specWithMapped mapped (Spec contextName moduleRoot layout ids enums rules nominalScalars _ nodes) =-  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes--specWithNominalScalars :: [NominalScalarDecl] -> Spec -> Spec-specWithNominalScalars nominalScalars (Spec contextName moduleRoot layout ids enums rules _ mapped nodes) =-  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes--specWithIds :: [IdDecl] -> Spec -> Spec-specWithIds ids (Spec contextName moduleRoot layout _ enums rules nominalScalars mapped nodes) =-  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes--specWithIdsAndNodes :: [IdDecl] -> [Node] -> Spec -> Spec-specWithIdsAndNodes ids nodes (Spec contextName moduleRoot layout _ enums rules nominalScalars mapped _) =-  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes--contractNodeWithEvents :: [ContractEvent] -> ContractNode -> ContractNode-contractNodeWithEvents events (ContractNode name schemaVersion discriminator topics _ loc) =-  ContractNode name schemaVersion discriminator topics events loc--commandWithFields :: [AggregateField] -> Command -> Command-commandWithFields fields (Command name _ loc) = Command name fields loc--contractEventWithFields :: [ContractField] -> ContractEvent -> ContractEvent-contractEventWithFields fields (ContractEvent name topic _) = ContractEvent name topic fields--contractEventWithTopic :: Name -> ContractEvent -> ContractEvent-contractEventWithTopic topic (ContractEvent name _ fields) = ContractEvent name topic fields--contractFieldWithName :: Name -> ContractField -> ContractField-contractFieldWithName name (ContractField _ selector wireKey valueType loc) =-  ContractField name selector wireKey valueType loc--bindRowWithField :: Name -> BindRow -> BindRow-bindRowWithField field (BindRow _ source required crossCheck) = BindRow field source required crossCheck--wireSpecWithKind :: T.Text -> WireSpec -> WireSpec-wireSpecWithKind kind (WireSpec _ fields schemaVersion) = WireSpec kind fields schemaVersion--wireSpecWithSchemaVersion :: Int -> WireSpec -> WireSpec-wireSpecWithSchemaVersion schemaVersion (WireSpec kind fields _) = WireSpec kind fields schemaVersion--wqDispRowWithAction :: InboxAction -> WqDispRow -> WqDispRow-wqDispRowWithAction action (WqDispRow outcome _ loc) = WqDispRow outcome action loc--dispositionRowWithAction :: InboxAction -> DispositionRow -> DispositionRow-dispositionRowWithAction action (DispositionRow outcome _ loc) = DispositionRow outcome action loc--bindRowWithSource :: WireSource -> BindRow -> BindRow-bindRowWithSource source (BindRow field _ required crossCheck) = BindRow field source required crossCheck--dispatchDispositionWithOnAppended :: Disp -> DispatchDisposition -> DispatchDisposition-dispatchDispositionWithOnAppended onAppended (DispatchDisposition _ onDuplicate onFailed) =-  DispatchDisposition onAppended onDuplicate onFailed--dispatchNodeWithDisposition :: DispatchDisposition -> DispatchNode -> DispatchNode-dispatchNodeWithDisposition disposition (DispatchNode target key command fields _ loc) =-  DispatchNode target key command fields disposition loc--dispatchNodeWithKey :: T.Text -> DispatchNode -> DispatchNode-dispatchNodeWithKey key (DispatchNode target _ command fields disposition loc) =-  DispatchNode target key command fields disposition loc--fieldBindingWithValue :: Maybe T.Text -> FieldBinding -> FieldBinding-fieldBindingWithValue value (FieldBinding name _) = FieldBinding name value--projectionSpecWithKey :: Name -> ProjectionSpec -> ProjectionSpec-projectionSpecWithKey key (ProjectionSpec table consistency _ statusMap loc) =-  ProjectionSpec table consistency key statusMap loc--eventWithNameAndLoc :: Name -> Loc -> Event -> Event-eventWithNameAndLoc name loc (Event _ body version upcastFrom retiring deprecated _) =-  Event name body version upcastFrom retiring deprecated loc--eventWithBody :: EventBody -> Event -> Event-eventWithBody body (Event name _ version upcastFrom retiring deprecated loc) =-  Event name body version upcastFrom retiring deprecated loc--contextWithModuleRoot :: T.Text -> Context -> Context-contextWithModuleRoot moduleRoot (Context name _ placement) = Context name moduleRoot placement--workspaceMemberWithSpec :: Spec -> WorkspaceMember -> WorkspaceMember-workspaceMemberWithSpec spec (WorkspaceMember path _ sourceLanguage sourceIndex lineBase lineCount) =-  WorkspaceMember path spec sourceLanguage sourceIndex lineBase lineCount--workspaceWithMembersAndMergedSpec :: [WorkspaceMember] -> Spec -> WorkspaceSpec -> WorkspaceSpec-workspaceWithMembersAndMergedSpec members mergedSpec workspace =-  WorkspaceSpec-    workspace.service-    workspace.manifestPath-    workspace.languageContract-    workspace.context-    workspace.runtimePackage-    workspace.moduleRoot-    workspace.layout-    members-    mergedSpec-    workspace.sourceIndex-    workspace.lineMap-    workspace.ownership--workspaceWithMergedSpecAndOwnership :: Spec -> OwnershipIndex -> WorkspaceSpec -> WorkspaceSpec-workspaceWithMergedSpecAndOwnership mergedSpec ownership workspace =-  WorkspaceSpec-    workspace.service-    workspace.manifestPath-    workspace.languageContract-    workspace.context-    workspace.runtimePackage-    workspace.moduleRoot-    workspace.layout-    workspace.members-    mergedSpec-    workspace.sourceIndex-    workspace.lineMap-    ownership--workspaceWithOwnership :: OwnershipIndex -> WorkspaceSpec -> WorkspaceSpec-workspaceWithOwnership ownership workspace =-  workspaceWithMergedSpecAndOwnership workspace.mergedSpec ownership workspace--workspaceWithAuthority :: T.Text -> Maybe T.Text -> Maybe Placement -> WorkspaceSpec -> WorkspaceSpec-workspaceWithAuthority service moduleRoot layout workspace =-  WorkspaceSpec-    service-    workspace.manifestPath-    workspace.languageContract-    workspace.context-    workspace.runtimePackage-    moduleRoot-    layout-    workspace.members-    workspace.mergedSpec-    workspace.sourceIndex-    workspace.lineMap-    workspace.ownership--workspaceWithContextAndMergedSpec :: Name -> Spec -> WorkspaceSpec -> WorkspaceSpec-workspaceWithContextAndMergedSpec contextName mergedSpec workspace =-  WorkspaceSpec-    workspace.service-    workspace.manifestPath-    workspace.languageContract-    contextName-    workspace.runtimePackage-    workspace.moduleRoot-    workspace.layout-    workspace.members-    mergedSpec-    workspace.sourceIndex-    workspace.lineMap-    workspace.ownership--workspaceWithManifestPath :: FilePath -> WorkspaceSpec -> WorkspaceSpec-workspaceWithManifestPath manifestPath workspace =-  WorkspaceSpec-    workspace.service-    manifestPath-    workspace.languageContract-    workspace.context-    workspace.runtimePackage-    workspace.moduleRoot-    workspace.layout-    workspace.members-    workspace.mergedSpec-    workspace.sourceIndex-    workspace.lineMap-    workspace.ownership--aggregateWithName :: Name -> Aggregate -> Aggregate-aggregateWithName name (Aggregate _ regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--aggregateWithProjection :: Maybe ProjectionSpec -> Aggregate -> Aggregate-aggregateWithProjection projection (Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire _ snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--aggregateWithTransitions :: [Transition] -> Aggregate -> Aggregate-aggregateWithTransitions transitions (Aggregate name regs states commands events _ domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--aggregateWithRegs :: [RegDecl] -> Aggregate -> Aggregate-aggregateWithRegs regs (Aggregate name _ states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--aggregateWithNameAndRegs :: Name -> [RegDecl] -> Aggregate -> Aggregate-aggregateWithNameAndRegs name regs (Aggregate _ _ states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--aggregateWithCommands :: [Command] -> Aggregate -> Aggregate-aggregateWithCommands commands (Aggregate name regs states _ events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--aggregateWithStates :: [StateDecl] -> Aggregate -> Aggregate-aggregateWithStates states (Aggregate name regs _ commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--aggregateWithCommandsEventsTransitions :: [Command] -> [Event] -> [Transition] -> Aggregate -> Aggregate-aggregateWithCommandsEventsTransitions commands events transitions (Aggregate name regs states _ _ _ domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--aggregateWithWire :: Maybe WireSpec -> Aggregate -> Aggregate-aggregateWithWire wire (Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs _ projection snapshot loc) =-  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc--regDeclWithInitial :: RegInitial -> RegDecl -> RegDecl-regDeclWithInitial initial (RegDecl name valueType _ loc) = RegDecl name valueType initial loc--regDeclWithValueType :: TypeExpr -> RegDecl -> RegDecl-regDeclWithValueType valueType (RegDecl name _ initial loc) = RegDecl name valueType initial loc--idDeclWithBinding :: Maybe NominalBindingDecl -> IdDecl -> IdDecl-idDeclWithBinding binding (IdDecl name prefix _ loc) = IdDecl name prefix binding loc--nominalBindingWithVersion :: Maybe T.Text -> NominalBindingDecl -> NominalBindingDecl-nominalBindingWithVersion bindingVersion (NominalBindingDecl haskell binding _ canonicalType fixtures initial loc) =-  NominalBindingDecl haskell binding bindingVersion canonicalType fixtures initial loc--transitionWithGuard :: Maybe Expr -> Transition -> Transition-transitionWithGuard guard (Transition source command implementation _ writes emits outcome outcomeDuplicateLocs goto mode loc) =-  Transition source command implementation guard writes emits outcome outcomeDuplicateLocs goto mode loc--transitionWithEmits :: [Name] -> Transition -> Transition-transitionWithEmits emits (Transition source command implementation guard writes _ outcome outcomeDuplicateLocs goto mode loc) =-  Transition source command implementation guard writes emits outcome outcomeDuplicateLocs goto mode loc--projectionOwnerWithReplay :: ProjectionReplayPolicy -> ProjectionOwnerNode -> ProjectionOwnerNode-projectionOwnerWithReplay replay (ProjectionOwnerNode name sources delivery group targets order subscription dedup checkpointOnMissing _ loc) =-  ProjectionOwnerNode name sources delivery group targets order subscription dedup checkpointOnMissing replay loc--readModelWithObservedTargets :: [Name] -> ReadModelNode -> ReadModelNode-readModelWithObservedTargets observedTargets (ReadModelNode name table schema columns version shape freshness supply group _ backingTarget queryTypes loc) =-  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc--readModelWithGroupAndObservedTargets :: Maybe Name -> [Name] -> ReadModelNode -> ReadModelNode-readModelWithGroupAndObservedTargets group observedTargets (ReadModelNode name table schema columns version shape freshness supply _ _ backingTarget queryTypes loc) =-  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc--readModelWithQueryTypes :: Maybe ReadModelQueryTypes -> ReadModelNode -> ReadModelNode-readModelWithQueryTypes queryTypes (ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget _ loc) =-  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc--workqueueWithPayload :: [WqField] -> WorkqueueNode -> WorkqueueNode-workqueueWithPayload payload (WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName _ maxRetries delay dlqOn disposition loc) =-  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc--workqueueWithName :: Name -> WorkqueueNode -> WorkqueueNode-workqueueWithName name (WorkqueueNode _ logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc) =-  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc--workqueueWithPayloadName :: Name -> WorkqueueNode -> WorkqueueNode-workqueueWithPayloadName payloadName (WorkqueueNode name logical physical dlq table ordering groupKey provision _ payload maxRetries delay dlqOn disposition loc) =-  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc--workqueueWithDelay :: T.Text -> WorkqueueNode -> WorkqueueNode-workqueueWithDelay delay (WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries _ dlqOn disposition loc) =-  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc--workqueueWithDisposition :: [WqDispRow] -> WorkqueueNode -> WorkqueueNode-workqueueWithDisposition disposition (WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn _ loc) =-  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc--wqFieldWithValueType :: QueuePayloadType -> WqField -> WqField-wqFieldWithValueType valueType (WqField name wire _ loc) = WqField name wire valueType loc--wireFieldWithHaskell :: Name -> WireField -> WireField-wireFieldWithHaskell haskell (WireField _ key valueType presence onMissing loc) =-  WireField haskell key valueType presence onMissing loc--wireFieldWithKey :: T.Text -> WireField -> WireField-wireFieldWithKey key (WireField haskell _ valueType presence onMissing loc) =-  WireField haskell key valueType presence onMissing loc--wireFieldWithValueType :: TypeExpr -> WireField -> WireField-wireFieldWithValueType valueType (WireField haskell key _ presence onMissing loc) =-  WireField haskell key valueType presence onMissing loc--wireFieldWithPresenceAndDefault :: Presence -> Maybe OnMissing -> WireField -> WireField-wireFieldWithPresenceAndDefault presence onMissing (WireField haskell key valueType _ _ loc) =-  WireField haskell key valueType presence onMissing loc--wireFieldWithOnMissing :: Maybe OnMissing -> WireField -> WireField-wireFieldWithOnMissing onMissing (WireField haskell key valueType presence _ loc) =-  WireField haskell key valueType presence onMissing loc--wireFieldWithPresence :: Presence -> WireField -> WireField-wireFieldWithPresence presence (WireField haskell key valueType _ onMissing loc) =-  WireField haskell key valueType presence onMissing loc--contractWithSchemaVersion :: Int -> ContractNode -> ContractNode-contractWithSchemaVersion schemaVersion (ContractNode name _ discriminator topics events loc) =-  ContractNode name schemaVersion discriminator topics events loc--contractWithTopics :: [(Name, T.Text)] -> ContractNode -> ContractNode-contractWithTopics topics (ContractNode name schemaVersion discriminator _ events loc) =-  ContractNode name schemaVersion discriminator topics events loc--publisherWithOrdering :: Name -> PublisherNode -> PublisherNode-publisherWithOrdering ordering (PublisherNode name emit _ maxAttempts backoff outboxField loc) =-  PublisherNode name emit ordering maxAttempts backoff outboxField loc--publisherWithBackoff :: BackoffSpec -> PublisherNode -> PublisherNode-publisherWithBackoff backoff (PublisherNode name emit ordering maxAttempts _ outboxField loc) =-  PublisherNode name emit ordering maxAttempts backoff outboxField loc--publisherWithMaxAttempts :: Int -> PublisherNode -> PublisherNode-publisherWithMaxAttempts maxAttempts (PublisherNode name emit ordering _ backoff outboxField loc) =-  PublisherNode name emit ordering maxAttempts backoff outboxField loc--publisherWithEmit :: Name -> PublisherNode -> PublisherNode-publisherWithEmit emit (PublisherNode name _ ordering maxAttempts backoff outboxField loc) =-  PublisherNode name emit ordering maxAttempts backoff outboxField loc--publisherWithOutboxField :: Name -> PublisherNode -> PublisherNode-publisherWithOutboxField outboxField (PublisherNode name emit ordering maxAttempts backoff _ loc) =-  PublisherNode name emit ordering maxAttempts backoff outboxField loc--backoffWithKind :: Name -> BackoffSpec -> BackoffSpec-backoffWithKind kind (BackoffSpec _ window maximumValue multiplier) = BackoffSpec kind window maximumValue multiplier--backoffWithWindow :: T.Text -> BackoffSpec -> BackoffSpec-backoffWithWindow window (BackoffSpec kind _ maximumValue multiplier) = BackoffSpec kind window maximumValue multiplier--intakeWithDedupePolicy :: Name -> IntakeNode -> IntakeNode-intakeWithDedupePolicy dedupePolicy (IntakeNode name contract topic accept binds dedupeKey _ persist decode disposition loc) =-  IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode disposition loc--intakeWithDedupeKey :: Name -> IntakeNode -> IntakeNode-intakeWithDedupeKey dedupeKey (IntakeNode name contract topic accept binds _ dedupePolicy persist decode disposition loc) =-  IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode disposition loc--intakeWithDecode :: DecodeSpec -> IntakeNode -> IntakeNode-intakeWithDecode decode (IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist _ disposition loc) =-  IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode disposition loc--intakeWithBinds :: [BindRow] -> IntakeNode -> IntakeNode-intakeWithBinds binds (IntakeNode name contract topic accept _ dedupeKey dedupePolicy persist decode disposition loc) =-  IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode disposition loc--intakeWithDisposition :: [DispositionRow] -> IntakeNode -> IntakeNode-intakeWithDisposition disposition (IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode _ loc) =-  IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode disposition loc--intakeWithContract :: Name -> IntakeNode -> IntakeNode-intakeWithContract contract (IntakeNode name _ topic accept binds dedupeKey dedupePolicy persist decode disposition loc) =-  IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode disposition loc--decodeWithEnvelope :: T.Text -> DecodeSpec -> DecodeSpec-decodeWithEnvelope envelope (DecodeSpec _ bodyStrict bodySchemaVersion) = DecodeSpec envelope bodyStrict bodySchemaVersion--decodeWithBodyStrict :: Bool -> DecodeSpec -> DecodeSpec-decodeWithBodyStrict bodyStrict (DecodeSpec envelope _ bodySchemaVersion) = DecodeSpec envelope bodyStrict bodySchemaVersion--decodeWithBodySchemaVersion :: Int -> DecodeSpec -> DecodeSpec-decodeWithBodySchemaVersion bodySchemaVersion (DecodeSpec envelope bodyStrict _) = DecodeSpec envelope bodyStrict bodySchemaVersion--emitNodeWithMap :: [EmitMapRow] -> EmitNode -> EmitNode-emitNodeWithMap mapping (EmitNode name contract topic source key discriminant _ skip messageId idempotencyKey loc) =-  EmitNode name contract topic source key discriminant mapping skip messageId idempotencyKey loc--workflowWithStable :: T.Text -> WorkflowNode -> WorkflowNode-workflowWithStable stable (WorkflowNode nodeId _ input inputFields output idField idVia body loc) =-  WorkflowNode nodeId stable input inputFields output idField idVia body loc--routerWithName :: T.Text -> RouterNode -> RouterNode-routerWithName name (RouterNode nodeId _ input key resolve target projections dispatch rejected poison loc) =-  RouterNode nodeId name input key resolve target projections dispatch rejected poison loc--readModelWithVersion :: Int -> ReadModelNode -> ReadModelNode-readModelWithVersion version (ReadModelNode name table schema columns _ shape freshness supply group observedTargets backingTarget queryTypes loc) =-  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc--readModelWithName :: Name -> ReadModelNode -> ReadModelNode-readModelWithName name (ReadModelNode _ table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc) =-  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc--readModelWithTable :: T.Text -> ReadModelNode -> ReadModelNode-readModelWithTable table (ReadModelNode name _ schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc) =-  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc--readModelWithColumns :: [RmColumn] -> ReadModelNode -> ReadModelNode-readModelWithColumns columns (ReadModelNode name table schema _ version shape freshness supply group observedTargets backingTarget queryTypes loc) =-  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc--readModelQueryTypesWithInput :: TypeExpr -> ReadModelQueryTypes -> ReadModelQueryTypes-readModelQueryTypesWithInput input (ReadModelQueryTypes _ result inputLoc resultLoc) =-  ReadModelQueryTypes input result inputLoc resultLoc--readModelQueryTypesWithResult :: TypeExpr -> ReadModelQueryTypes -> ReadModelQueryTypes-readModelQueryTypesWithResult result (ReadModelQueryTypes input _ inputLoc resultLoc) =-  ReadModelQueryTypes input result inputLoc resultLoc--processWithTimer :: TimerNode -> ProcessNode -> ProcessNode-processWithTimer timer (ProcessNode nodeId name input correlate saga target projections handle rejected poison _ loc) =-  ProcessNode nodeId name input correlate saga target projections handle rejected poison timer loc--processWithHandle :: HandleNode -> ProcessNode -> ProcessNode-processWithHandle handle (ProcessNode nodeId name input correlate saga target projections _ rejected poison timer loc) =-  ProcessNode nodeId name input correlate saga target projections handle rejected poison timer loc--processWithSaga :: SagaRef -> ProcessNode -> ProcessNode-processWithSaga saga (ProcessNode nodeId name input correlate _ target projections handle rejected poison timer loc) =-  ProcessNode nodeId name input correlate saga target projections handle rejected poison timer loc--processWithCorrelate :: CorrelateDecl -> ProcessNode -> ProcessNode-processWithCorrelate correlate (ProcessNode nodeId name input _ saga target projections handle rejected poison timer loc) =-  ProcessNode nodeId name input correlate saga target projections handle rejected poison timer loc+import Data.Maybe (fromMaybe)+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.Encoding qualified as TextEncoding+import Data.Text.IO qualified as TIO+import Data.Text.Lazy qualified as LazyText+import Data.Text.Lazy.Encoding qualified as LazyTextEncoding+import Data.Version (showVersion)+import Keiki.ProjectionDomain (matchesTextPattern)+import Keiro.Codec (Codec (..), EventType (..), decodeRaw)+import Keiro.Codec.IdDomain (IdDomainFailure (..), idDomainSampleText, idDomainTextPattern, parseKindIdV7Text, parseKindIdV7Value, typeIdV7Domain, validateIdDomainText)+import Keiro.Dsl.AggregateType+import Keiro.Dsl.BehaviorCoverage qualified as Behavior+import Keiro.Dsl.BehaviorSourceMap qualified as BehaviorSource+import Keiro.Dsl.CanonicalEncoding (foldFingerprint128)+import Keiro.Dsl.CodecCompare+import Keiro.Dsl.ConformanceBaseline (conformanceBaselineSpec)+import Keiro.Dsl.ConformancePackage+import Keiro.Dsl.ConsumerTypePlan+import Keiro.Dsl.CoordinationImpact+import Keiro.Dsl.Coverage qualified as Coverage+import Keiro.Dsl.Diff (Change (..), ChangeKind (..), CompatibilitySurface (..), CompatibilityVector (..), FamilyDiff (..), Label (..), MappedPersistedImpact (..), MappedPersistedSurface (..), NodeFamily, RolloutConstraint (..), SurfaceVerdict (..), defaultGate, deriveLabel, familyRegistry, gateWith, gatedBreaking, isAdvisory, isBreaking, verdictFor)+import Keiro.Dsl.Diff qualified as CheckedDiff+import Keiro.Dsl.DiffReport (Remedy (..), diffReport, diffReportWithImpacts, diffReportWithSemanticImpact, parseSurfaceName, remediationFor, renderExplainBlock, renderFinding, renderSemanticImpact)+import Keiro.Dsl.EventOutput+import Keiro.Dsl.ExplainBindings (BindingHole (..), BindingObligation (..), BindingObligationKind (..), bindingHoles, bindingObligations, bindingObligationsForService, renderBindingObligations)+import Keiro.Dsl.Expression+import Keiro.Dsl.FoldFingerprint (FoldSurfaceError (..))+import Keiro.Dsl.FoldFingerprint qualified as CheckedFold+import Keiro.Dsl.Frontend (FrontendErrorCode (..), FrontendFailure (..), LoweringFailure (..), LoweringFailureCode (..), lowerSurfaceDocument, parseSurfaceSource, renderFrontendFailure)+import Keiro.Dsl.FrontendCompatibility (frontendCompatibilitySpec)+import Keiro.Dsl.FrontendProfiles (frontendProfilesSpec)+import Keiro.Dsl.FrontendSurface (frontendSurfaceSpec)+import Keiro.Dsl.GeneratedHaskellLanguage (RewriteState (..), modernizeGeneratedHaskellSourceWithState)+import Keiro.Dsl.Goldens (GoldenEvidence (..), GoldenPayload (..), emitGoldenPayloads, goldenRelativePath, goldensForDiff)+import Keiro.Dsl.Grammar+import Keiro.Dsl.Grammar qualified as Grammar+import Keiro.Dsl.Harness (harnessFor, harnessForService, harnessForWithGoldens, harnessReadModel, harnessRouter, harnessWorkflow)+import Keiro.Dsl.HaskellImport+import Keiro.Dsl.HaskellSourceMove+import Keiro.Dsl.IdDomain (IdDomainContract (..), contractIdDomainContractFor, idDomainContractFor, idDomainIdentitiesForService)+import Keiro.Dsl.LanguageVersion+import Keiro.Dsl.Manifest (manifestDependencies, manifestDependenciesForService, moduleNameOf, renderManifest, renderManifestForService, renderManifestForServiceWithFacade)+import Keiro.Dsl.MappedCodecPlan+import Keiro.Dsl.MappedConsumer (ConsumerPlan (..), MappingIdentity (..), consumerPlan)+import Keiro.Dsl.MappedDiff (MappedFinding (..), diffMapped)+import Keiro.Dsl.NominalType hiding (NominalInvalidHaskellSource, NominalInvalidIdPrefix, NominalInvalidIdentity, NominalMissingIngredient)+import Keiro.Dsl.Parser (parseSource, parseSourceDocument, parseSpec)+import Keiro.Dsl.PrettyPrint (renderSource, renderSpec, renderTransition)+import Keiro.Dsl.ProcessReaction (processReactionFingerprintFrom)+import Keiro.Dsl.ProjectionMappedImpact qualified as ProjectionImpact+import Keiro.Dsl.ProjectionSupply+import Keiro.Dsl.ReadModelQueryContract (QueryContractDrift (..), QueryContractIdentity (..), QueryContractPosition (..), queryContractIdentities)+import Keiro.Dsl.ReadModelShape (canonicalShape, deriveShapeHash, registryNameFor, subscriptionNameFor)+import Keiro.Dsl.ReplayImpact (AggregateImpact (..), CatalogReplayImpact (..), ReplayImpact (..))+import Keiro.Dsl.ReplayImpact qualified as ReplayImpact+import Keiro.Dsl.RouterSelection qualified as RouterSelection+import Keiro.Dsl.Scaffold (Context (..), ModuleKind (..), ModuleRole (..), NominalGenerationOwner (..), NominalUseSite (..), ScaffoldModule (..), StructuralProjection (..), codecComparisonBanner, codecComparisonModule, defaultContext, firewallBreaches, genPrefixFor, generatedBanner, generatedBannerFor, generatedNominalModule, holePrefixFor, isGeneratedBannerLine, moduleRole, obsoleteGeneratedOutputHooks, planNominalGeneration, projectionSpecs, scaffoldAggregate, scaffoldAggregateForService, scaffoldContract, scaffoldContractForService, scaffoldIntake, scaffoldProcess, scaffoldProjectionCatalog, scaffoldPublisher, scaffoldReadModel, scaffoldReadModelForService, scaffoldRefusals, scaffoldReplayAudit, scaffoldRouter, scaffoldStructural, scaffoldWorkqueue, scaffoldWorkqueueForService, windowSeconds)+import Keiro.Dsl.ScaffoldRecord (GeneratedHaskellNamingEdition (..), ScaffoldModuleRoleRow (..), ScaffoldRecord (..), parseRecord, projectionCatalogFacts, projectionCatalogFactsForService, recordFileName, renderRecord)+import Keiro.Dsl.ScaffoldRun (GeneratedArtifactCategory (..), GeneratedArtifactImpact (..), GeneratedHaskellEditionImpact (..), GeneratedHaskellEditionUse (..), HoleUseForm (..), MappingDrift (..), QueryContractMigration (..), Refusal (..), ScaffoldReport (..), SourceLanguageDrift (..), StaleGeneratedEvidence (..), StaleModule (..), WriteDisposition (..), auditGeneratedHaskell, checkIndexedServiceDiagnostics, executeScaffold, executeScaffoldWithLanguage, executeServiceScaffold, executeServiceScaffoldWithRuntimePackage, executeServiceScaffoldWithRuntimePackageAndMigrations, executeServiceScaffoldWithRuntimePackageAndNameMigrations, planIndexedServiceScaffold, planIndexedServiceScaffoldWithRuntimePackage, planningRefusalDiagnostics, renderRefusals, renderScaffoldReport, renderSemanticImpactReport, scaffoldModules, scaffoldServiceModules)+import Keiro.Dsl.SemanticContract+import Keiro.Dsl.SemanticImpact+import Keiro.Dsl.SemanticImpact qualified as SemanticImpact+import Keiro.Dsl.ServiceHarness+import Keiro.Dsl.SidecarMigration+import Keiro.Dsl.SidecarNames+import Keiro.Dsl.Skeleton (skeletonFor, skeletonKinds)+import Keiro.Dsl.Source (SourcePoint (..), SourceSpan (..))+import Keiro.Dsl.SourceIndex+import Keiro.Dsl.TypeGraph+import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode (..), Severity (..), derivedQueueTrio, diagnosticCodeText, parseDiagnosticCode, renderDiagnostic, validateService, validateSpec)+import Keiro.Dsl.Workspace+import Keiro.Dsl.Workspace qualified as Workspace+import Keiro.Dsl.WorkspaceAdoption+import Keiro.Dsl.WorkspaceDiff hiding (diffWorkspaces)+import Keiro.Dsl.WorkspaceDiff qualified as CheckedWorkspaceDiff+import Keiro.Dsl.WorkspaceRecord+import Keiro.Dsl.WorkspaceRecord qualified as WorkspaceRecord+import Keiro.Dsl.WorkspaceScaffold+import Paths_keiro_dsl qualified as Package+import System.Directory (canonicalizePath, createDirectory, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getTemporaryDirectory, listDirectory, removeFile, removePathForcibly, renameFile, withCurrentDirectory)+import System.Environment (lookupEnv)+import System.Exit (ExitCode (..))+import System.FilePath (takeDirectory, takeExtension, takeFileName, (</>))+import System.IO (hClose, openTempFile)+import System.Process (readProcessWithExitCode)+import Test.Hspec hiding (Spec)+import Test.QuickCheck++resolvedFold :: Either FoldSurfaceError value -> value+resolvedFold = either (error . ("unexpected fold-surface failure in checked fixture: " <>) . show) id++aggregateFoldFingerprintForService :: CheckedService -> Aggregate -> T.Text+aggregateFoldFingerprintForService service aggregate = resolvedFold (CheckedFold.aggregateFoldFingerprintForService service aggregate)++aggregateFoldSurfaceForService :: CheckedService -> Aggregate -> T.Text+aggregateFoldSurfaceForService service aggregate = resolvedFold (CheckedFold.aggregateFoldSurfaceForService service aggregate)++aggregateFoldFingerprint :: Spec -> Aggregate -> T.Text+aggregateFoldFingerprint spec aggregate = aggregateFoldFingerprintForService (stableCheckedService spec) aggregate++aggregateFoldSurface :: Spec -> Aggregate -> T.Text+aggregateFoldSurface spec aggregate = aggregateFoldSurfaceForService (stableCheckedService spec) aggregate++legacyAggregateFoldFingerprint :: Spec -> Aggregate -> T.Text+legacyAggregateFoldFingerprint spec aggregate = aggregateFoldFingerprintForService (legacyCheckedService spec) aggregate++legacyAggregateFoldSurface :: Spec -> Aggregate -> T.Text+legacyAggregateFoldSurface spec aggregate = aggregateFoldSurfaceForService (legacyCheckedService spec) aggregate++diffServices :: CheckedService -> CheckedService -> [Change]+diffServices old new = resolvedFold (CheckedDiff.diffServices old new)++diffSources :: ParsedSource -> ParsedSource -> [Change]+diffSources old new = resolvedFold (CheckedDiff.diffSources old new)++diffSpecs :: Spec -> Spec -> [Change]+diffSpecs old new = diffServices (stableCheckedService old) (stableCheckedService new)++legacyDiffSpecs :: Spec -> Spec -> [Change]+legacyDiffSpecs old new = diffServices (legacyCheckedService old) (legacyCheckedService new)++diffWorkspaces :: WorkspaceSpec -> WorkspaceSpec -> [WorkspaceChange]+diffWorkspaces old new = resolvedFold (CheckedWorkspaceDiff.diffWorkspaces old new)++replayImpactSpecs :: Spec -> Spec -> ReplayImpact+replayImpactSpecs old new =+  resolvedFold (ReplayImpact.replayImpactServices (stableCheckedService old) (stableCheckedService new))++legacyReplayImpactSpecs :: Spec -> Spec -> ReplayImpact+legacyReplayImpactSpecs old new =+  resolvedFold (ReplayImpact.replayImpactServices (legacyCheckedService old) (legacyCheckedService new))++nominalEqualityIdentities :: Spec -> [T.Text]+nominalEqualityIdentities = nominalEqualityIdentitiesForService . stableCheckedService++stableCheckedService :: Spec -> CheckedService+stableCheckedService = checkedService stableSourceLanguage++stableSourceLanguage :: SourceLanguage+stableSourceLanguage =+  DeclaredLanguage+    { declaredLanguageVersion = currentStableLanguageVersion,+      languageVersionLoc = noLoc+    }++main :: IO ()+main = hspec $ do+  conformanceBaselineSpec+  frontendCompatibilitySpec+  frontendSurfaceSpec+  frontendProfilesSpec++  describe "mapped consumer surface" $ do+    it "parses and canonically round-trips Language 5 queue and query expressions as atomic forms" $ do+      source <- mappedConsumerSurfaceSource+      parsed <- case parseSource "<mapped-consumer>" source of+        Left failure -> expectationFailure (show failure) >> fail "unreachable"+        Right value -> pure value+      parseSource "<mapped-consumer-roundtrip>" (renderSource parsed) `shouldBe` Right parsed+      let spec = parsed.spec+      case [field | NWorkqueue workqueue <- (.nodes) spec, field <- (.payload) workqueue] of+        [field] -> do+          (.valueType) field `shouldBe` TypedQueueExpression (TList (TOptional (TRef "ArtifactInfo")))+          unLoc ((.loc) field) `shouldSatisfy` (> 0)+        fields -> expectationFailure ("unexpected mapped queue fields: " <> show fields)+      case [types | NReadModel readModel <- (.nodes) spec, Just types <- [(.queryTypes) readModel]] of+        [ReadModelQueryTypes {input, result}] -> do+          input `shouldBe` TRef "ArtifactInfo"+          result `shouldBe` TOptional (TRef "ArtifactLocation")+        queryPairs -> expectationFailure ("unexpected mapped query pairs: " <> show queryPairs)+      let missingInput = T.replace "  query input = ArtifactInfo\n" "" source+          missingResult = T.replace "  query result = Optional ArtifactLocation\n" "" source+      parseSource "<mapped-consumer-missing-input>" missingInput `shouldSatisfy` isLeft+      parseSource "<mapped-consumer-missing-result>" missingResult `shouldSatisfy` isLeft++    it "resolves nested queue and query roots and plans one deterministic consumer-facing Haskell type" $ do+      source <- mappedConsumerSurfaceSource+      spec <- parseInlineSpec "<mapped-consumer-graph>" source+      graph <- shouldResolveTypeGraph spec+      map renderUsePath (usePaths graph "ArtifactLocation")+        `shouldContain` [ "workqueue ArtifactJobs payload .jobData : ArtifactInfo [] optional .location : ArtifactLocation",+                          "readmodel ArtifactLookup query input : ArtifactInfo .location : ArtifactLocation",+                          "readmodel ArtifactLookup query result : ArtifactLocation optional"+                        ]+      planConsumerType graph (RList (ROptional (RRef (MappedKey "ArtifactInfo"))))+        `shouldBe` Right+          ConsumerTypePlan+            { haskellType = HaskellTypeOccurrence "[Maybe ArtifactInfo]",+              imports =+                [ ImportRequirement "artifact-domain" "Example.Artifact.Domain" "ArtifactInfo",+                  ImportRequirement "base" "Data.Maybe" "Maybe"+                ],+              dependencies = Set.fromList [MappedKey "ArtifactInfo", MappedKey "ArtifactKind", MappedKey "ArtifactLocation"],+              nominalDependencies = Set.empty+            }+      unresolved <-+        parseInlineSpec+          "<mapped-consumer-unresolved>"+          (T.replace "List (Optional ArtifactInfo)" "List (Optional MissingPayload)" source)+      case resolveTypeGraph unresolved of+        Left errors ->+          NE.toList errors+            `shouldSatisfy` any+              ( \case+                  TGUnresolvedConsumerRef owner missing loc ->+                    owner == "workqueue 'ArtifactJobs' payload field 'jobData'"+                      && missing == "MissingPayload"+                      && unLoc loc > 0+                  _ -> False+              )+        Right _ -> expectationFailure "unresolved mapped queue reference unexpectedly resolved"++    it "plans one recursive mapped codec algebra for consumer and structural boundaries" $ do+      source <- mappedConsumerSurfaceSource+      spec <- parseInlineSpec "<mapped-codec-plan>" source+      graph <- shouldResolveTypeGraph spec+      let expression = RList (ROptional (RRef (MappedKey "ArtifactInfo")))+      case planMappedCodec graph expression of+        Left failure -> expectationFailure (show failure)+        Right planned -> do+          (.authority) planned `shouldBe` Set.singleton (StructuralAuthority (MappedKey "ArtifactInfo"))+          renderMappedEncode graph ConsumerValueBoundary planned "payload.jobs"+            `shouldBe` "toJSON (map (\\item0 -> maybe Null (\\item1 -> encodeArtifactInfoMapped item1) (item0)) (payload.jobs))"+          renderMappedParse graph ConsumerValueBoundary planned+            `shouldBe` "\\value0 -> do items0 <- (parseJSON value0 :: Parser [Value]); traverse (\\(index0, item0) -> (\\value1 -> case value1 of Null -> pure Nothing; other1 -> Just <$> (parseArtifactInfoMapped) other1) item0 <?> Index index0) (zip [0..] items0)"+          let references = consumerTypeReferences ((.consumerType) planned)+          case planHaskellImports (ImportEnvironment "Generated.Test.Queue" (Set.singleton "Payload") Set.empty) references of+            Left failure -> expectationFailure (show failure)+            Right importPlan ->+              renderConsumerType "Generated.Test.Nominals" importPlan graph expression+                `shouldBe` Right (HaskellTypeOccurrence "[Maybe ArtifactInfo]")++    it "derives mapped projection impact from aggregate event authority and exposes heterogeneous boundaries" $ do+      source <- mappedConsumerSurfaceSource+      base <- parseInlineSpec "<mapped-consumer-projections>" source+      let projection = ProjectionSpec "artifact_view" (Just Eventual) "key" Nothing noLoc+          withInlineProjection node = case node of+            NAggregate aggregate -> NAggregate (aggregateWithProjection (Just projection) aggregate)+            NReadModel readModel@ReadModelNode {name = "ArtifactLookup"} ->+              NReadModel (readModelWithGroupAndObservedTargets (Just "artifact_group") ["artifact_target"] readModel)+            other -> other+          owner name sourceKind feed groupName targetNames replayPolicy =+            NProjectionOwner+              ProjectionOwnerNode+                { name = name,+                  sources = [sourceKind],+                  delivery = case feed of RmInline -> DeliveryInline; RmSubscription -> DeliverySubscription,+                  group = groupName,+                  targets = targetNames,+                  order = 1,+                  subscription = if feed == RmSubscription then Just (name <> "-subscription") else Nothing,+                  dedup = if feed == RmSubscription then Just (name <> "-dedup") else Nothing,+                  checkpointOnMissing = if feed == RmSubscription then [CheckpointFromBeginning] else [],+                  replay = replayPolicy,+                  loc = noLoc+                }+          target name = NProjectionTarget (ProjectionTargetNode name "public" name TargetClear [] noLoc)+          groupNode name targetName = NRebuildGroup (RebuildGroupNode name [targetName] [targetName] noLoc)+          disjointReadModel =+            NReadModel+              ReadModelNode+                { name = "DisjointLookup",+                  table = "disjoint_lookup",+                  schema = "public",+                  columns = [],+                  version = 1,+                  shape = "fixture",+                  freshness = FreshnessImmediate,+                  supply = LegacyReadModelSupply Eventual Nothing RmSubscription (Just "disjoint-lookup"),+                  group = Just "disjoint_group",+                  observedTargets = ["disjoint_target"],+                  backingTarget = Nothing,+                  queryTypes = Nothing,+                  loc = noLoc+                }+          spec =+            specWithNodes+              ( map withInlineProjection base.nodes+                  <> [ target "artifact_target",+                       target "disjoint_target",+                       groupNode "artifact_group" "artifact_target",+                       groupNode "disjoint_group" "disjoint_target",+                       owner "artifactProjection" (CatalogAggregate "Catalog") RmSubscription "artifact_group" ["artifact_target"] ProjectionReplayExplicit,+                       owner "liveProjection" (CatalogAggregate "Catalog") RmInline "disjoint_group" ["disjoint_target"] (ProjectionLiveOnly "live only"),+                       owner "categoryProjection" (CatalogCategory "artifact") RmSubscription "artifact_group" ["artifact_target"] ProjectionReplayExplicit,+                       owner "allProjection" CatalogAll RmInline "disjoint_group" ["disjoint_target"] (ProjectionLiveOnly "heterogeneous"),+                       disjointReadModel+                     ]+              )+              base+      impact <- semanticImpact <$> shouldResolveTypeGraph spec+      Set.fromList (mappedDeclarationConsumers impact (MappedKey "ArtifactLocation"))+        `shouldBe` Set.fromList+          [ AggregateConsumer "Catalog",+            WorkqueueConsumer "ArtifactJobs",+            ReadModelQueryConsumer "ArtifactLookup" MappedQueryInput,+            ReadModelQueryConsumer "ArtifactLookup" MappedQueryResult,+            DerivedProjectionConsumer (AggregateInlineProjectionConsumer "Catalog" "artifact_view"),+            DerivedProjectionConsumer (CatalogProjectionConsumer "artifactProjection" "Catalog"),+            DerivedProjectionConsumer (CatalogProjectionConsumer "liveProjection" "Catalog")+          ]+      Set.fromList ((.unsupportedProjectionSources) impact)+        `shouldBe` Set.fromList+          [ UnsupportedCatalogCategory "categoryProjection" "artifact",+            UnsupportedCatalogAll "allProjection"+          ]+      let projected = ProjectionImpact.projectionMappedImpact (stableCheckedService spec) impact+          locationConsumers = ProjectionImpact.projectionConsumersFor projected (MappedKey "ArtifactLocation")+      locationConsumers+        `shouldBe` Set.fromList+          [ AggregateInlineProjectionConsumer "Catalog" "artifact_view",+            CatalogProjectionConsumer "artifactProjection" "Catalog",+            CatalogProjectionConsumer "liveProjection" "Catalog"+          ]+      ( [ renderUsePath inheritedPath+        | ProjectionImpact.ProjectionMappedRoot derived declarationKey inheritedPath <- (.roots) projected,+          derived == CatalogProjectionConsumer "artifactProjection" "Catalog",+          declarationKey == MappedKey "ArtifactLocation"+        ]+        )+        `shouldBe` ["Catalog event ArtifactObserved .artifact : ArtifactInfo .location : ArtifactLocation"]+      ProjectionImpact.projectionOperationsFor projected (MappedKey "ArtifactLocation")+        `shouldBe` [ ProjectionImpact.ProjectionOperationalImpact+                       (AggregateInlineProjectionConsumer "Catalog" "artifact_view")+                       Nothing+                       (Set.singleton "artifact_view")+                       Set.empty+                       False+                       (ProjectionImpact.projectionAggregateSourceFingerprint spec "Catalog"),+                     ProjectionImpact.ProjectionOperationalImpact+                       (CatalogProjectionConsumer "artifactProjection" "Catalog")+                       (Just "artifact_group")+                       (Set.singleton "artifact_target")+                       (Set.singleton "ArtifactLookup")+                       True+                       (ProjectionImpact.projectionAggregateSourceFingerprint spec "Catalog"),+                     ProjectionImpact.ProjectionOperationalImpact+                       (CatalogProjectionConsumer "liveProjection" "Catalog")+                       (Just "disjoint_group")+                       (Set.singleton "disjoint_target")+                       (Set.singleton "DisjointLookup")+                       False+                       (ProjectionImpact.projectionAggregateSourceFingerprint spec "Catalog")+                   ]+      (.unsupported) projected+        `shouldBe` [ ProjectionImpact.UnsupportedProjectionImpact+                       (UnsupportedCatalogCategory "categoryProjection" "artifact")+                       "artifact_group"+                       (Set.singleton "artifact_target")+                       (Set.singleton "ArtifactLookup")+                       True,+                     ProjectionImpact.UnsupportedProjectionImpact+                       (UnsupportedCatalogAll "allProjection")+                       "disjoint_group"+                       (Set.singleton "disjoint_target")+                       (Set.singleton "DisjointLookup")+                       False+                   ]+      let baseFingerprint = ProjectionImpact.projectionAggregateSourceFingerprint spec "Catalog"+          wireChanged = mapMappedDeclaration "ArtifactLocation" changeProjectionMappedWire spec+          commandOnly = projectionEventWithoutGeometry spec+          commandOnlyChanged = mapMappedDeclaration "VendorGeometry" changeProjectionMappedWire commandOnly+      ProjectionImpact.projectionAggregateSourceFingerprint wireChanged "Catalog" `shouldNotBe` baseFingerprint+      ProjectionImpact.projectionAggregateSourceFingerprint commandOnlyChanged "Catalog"+        `shouldBe` ProjectionImpact.projectionAggregateSourceFingerprint commandOnly "Catalog"+      let generatedCatalog candidate =+            generatedTextEndingIn "ProjectionCatalog.hs" (scaffoldProjectionCatalog (defaultContext (candidate.context)) candidate)+          baseCatalog = generatedCatalog spec+      baseCatalog `shouldSatisfy` T.isInfixOf (T.pack (show baseFingerprint))+      generatedCatalog wireChanged `shouldNotBe` baseCatalog+      generatedCatalog commandOnlyChanged `shouldBe` generatedCatalog commandOnly+      let projectionChanges =+            [ kindOfChange change+            | change <- diffSpecs spec wireChanged,+              (.facet) (kindOfChange change) == "mapped-projection"+            ]+      map (.node) projectionChanges `shouldBe` ["Catalog", "artifactProjection", "liveProjection"]+      map (.subject) projectionChanges+        `shouldBe` [ "aggregate-projection:Catalog:artifact_view inherits ArtifactLocation",+                     "catalog-projection:artifactProjection:Catalog inherits ArtifactLocation",+                     "catalog-projection:liveProjection:Catalog inherits ArtifactLocation"+                   ]+      map (.paths) projectionChanges+        `shouldBe` replicate 3 ["Catalog event ArtifactObserved .artifact : ArtifactInfo .location : ArtifactLocation"]+      projectionChanges `shouldSatisfy` all ((== VAdvisory) . (.consumerBuild) . (.vector))+      map (.detail) projectionChanges+        `shouldSatisfy` any (T.isInfixOf "group=artifact_group, targets=[artifact_target], read-models=[ArtifactLookup], replayable=yes")+      [kindOfChange change | change <- diffSpecs commandOnly commandOnlyChanged, (.facet) (kindOfChange change) == "mapped-projection"]+        `shouldBe` []+      case ReplayImpact.catalogReplayImpactServices (stableCheckedService spec) (stableCheckedService wireChanged) of+        CatalogReplayAffected groups targets sources adapters invalidates -> do+          groups `shouldBe` Set.singleton "artifact_group"+          targets `shouldBe` Set.singleton "artifact_target"+          sources `shouldBe` Set.singleton "aggregate:Catalog"+          adapters `shouldBe` Set.singleton "artifactProjection"+          invalidates `shouldBe` True+        CatalogReplayNeutral -> expectationFailure "mapped event wire change was catalog replay-neutral"+      ReplayImpact.catalogReplayImpactServices (stableCheckedService commandOnly) (stableCheckedService commandOnlyChanged)+        `shouldBe` CatalogReplayNeutral+      let snapshot = semanticImpactSnapshot impact+      Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot++    it "lowers mapped queues and checked read-model query contracts" $ do+      source <- mappedConsumerSurfaceSource+      parsed <- case parseSource "<mapped-consumer-pending>" source of+        Left failure -> expectationFailure (show failure) >> fail "unreachable"+        Right value -> pure value+      let codes = map (.code) (validateService (checkedSource parsed))+      codes `shouldNotContain` [MappedReadModelLoweringPending]+      codes `shouldNotContain` [MappedQueueLoweringPending]+      case [workqueue | NWorkqueue workqueue <- (.nodes) ((.spec) parsed)] of+        [workqueue] -> do+          let modules = scaffoldWorkqueueForService (defaultContext (parsed.spec.context)) (checkedSource parsed) workqueue+              queue = generatedTextEndingIn "Queue.hs" modules+          queue `shouldSatisfy` T.isInfixOf "jobData :: ![Maybe ArtifactInfo]"+          queue `shouldSatisfy` T.isInfixOf "encodeArtifactInfoMapped"+          queue `shouldSatisfy` T.isInfixOf "<?> Index index0"+          queue `shouldNotSatisfy` T.isInfixOf "Vendor.Geometry"+        workqueues -> expectationFailure ("unexpected workqueues: " <> show workqueues)+      case [readModel | NReadModel readModel <- (.nodes) ((.spec) parsed)] of+        [readModel] -> do+          let ctx = defaultContext (parsed.spec.context)+              modules = scaffoldReadModelForService ctx (checkedSource parsed) readModel+              contract = generatedTextEndingIn "QueryContract.hs" modules+              generatedReadModel = generatedTextEndingIn "ReadModel.hs" modules+              holes = T.intercalate "\n" [(.text) value | value <- modules, (.kind) value == HoleStub]+          contract `shouldSatisfy` T.isInfixOf "type ArtifactLookupQueryInput = ArtifactInfo"+          contract `shouldSatisfy` T.isInfixOf "type ArtifactLookupQueryResult = Maybe ArtifactLocation"+          contract `shouldSatisfy` T.isInfixOf "import Example.Artifact.Domain (ArtifactInfo, ArtifactLocation)"+          contract `shouldNotSatisfy` T.isInfixOf "Vendor.Geometry"+          generatedReadModel `shouldSatisfy` T.isInfixOf ".QueryContract (ArtifactLookupQueryInput, ArtifactLookupQueryResult)"+          generatedReadModel `shouldSatisfy` T.isInfixOf ".ReadModelHoles (artifactLookupQuery)"+          generatedReadModel `shouldNotSatisfy` T.isInfixOf "applyArtifactLookup"+          holes `shouldSatisfy` T.isInfixOf ".QueryContract (ArtifactLookupQueryInput, ArtifactLookupQueryResult)"+          holes `shouldNotSatisfy` T.isInfixOf "type ArtifactLookupQueryInput = ()"+        readModels -> expectationFailure ("unexpected mapped read models: " <> show readModels)+      queryContractIdentities ((.spec) parsed)+        `shouldBe` Right+          [ QueryContractIdentity+              { readModel = "ArtifactLookup",+                position = QueryInputConsumer,+                typeExpression = "ArtifactInfo",+                mappedDependencies = ["ArtifactInfo", "ArtifactKind", "ArtifactLocation"]+              },+            QueryContractIdentity+              { readModel = "ArtifactLookup",+                position = QueryResultConsumer,+                typeExpression = "Optional ArtifactLocation",+                mappedDependencies = ["ArtifactLocation"]+              }+          ]++    it "reports a retained legacy query hole until the application adopts the generated aliases" $+      withTempDirectory "keiro-dsl-query-contract-migration" $ \out -> do+        source <- mappedConsumerSurfaceSource+        parsed <- case parseSource "<mapped-query-migration>" source of+          Left failure -> expectationFailure (show failure) >> fail "unreachable"+          Right value -> pure value+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+        modules <- case planTestServiceScaffold ctx service of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right values -> pure values+        readModel <- case [value | NReadModel value <- (.nodes) spec] of+          [value] -> pure value+          values -> expectationFailure ("unexpected mapped read models: " <> show values) >> fail "unreachable"+        let typedHole = case [value | value <- modules, (.kind) value == HoleStub, "ReadModelHoles.hs" `T.isSuffixOf` T.pack (value.path)] of+              [value] -> value+              values -> error ("expected one query hole, got " <> show (map (.path) values))+            legacyHole = case [value | value <- scaffoldReadModel ctx readModel, (.kind) value == HoleStub] of+              [value] -> value+              values -> error ("expected one legacy query hole, got " <> show (map (.path) values))+            holePath = out </> typedHole.path+            run = executeServiceScaffold out False "mapped-query.keiro" ((.sourceLanguage) parsed) ctx service modules+        createDirectoryIfMissing True (takeDirectory holePath)+        TIO.writeFile holePath ((.text) legacyHole)+        TIO.writeFile+          (out </> recordFileName (spec.context))+          ( renderRecord+              ScaffoldRecord+                { specPath = "mapped-query.keiro",+                  moduleRoot = "",+                  layout = "prefixed",+                  sourceLanguage = (.sourceLanguage) parsed,+                  languageContract = checkedLanguageContract service,+                  namingEdition = IdiomaticNamingV2,+                  moduleRoles = [],+                  files = [],+                  mappings = [],+                  idDomains = [],+                  nominalEqualities = [],+                  bindingObligations = [],+                  behaviorRequirements = [],+                  projectionCatalogFacts = [],+                  queryContractBaseline = False,+                  queryContracts = [],+                  routerSelections = [],+                  processReactions = [],+                  semanticImpact = Nothing+                }+          )+        first <- run >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure+        (.queryContractBaselineUnavailable) first `shouldBe` True+        (.queryContractMigrations) first+          `shouldBe` [ QueryContractMigration+                         { owner = "ArtifactLookup",+                           path = typedHole.path,+                           requiredImport = "import Generated.ConsumerDemo.ArtifactLookup.QueryContract (ArtifactLookupQueryInput, ArtifactLookupQueryResult)"+                         }+                     ]+        renderScaffoldReport first `shouldSatisfy` any (T.isInfixOf "remove the local QueryInput/QueryResult type aliases")+        renderScaffoldReport first `shouldSatisfy` any (T.isInfixOf "baseline unavailable")+        currentLedger <- TIO.readFile ((.recordPath) first)+        case parseRecord currentLedger of+          Just record -> do+            (.queryContractBaseline) record `shouldBe` True+            length ((.queryContracts) record) `shouldBe` 2+          Nothing -> expectationFailure "standalone query-contract ledger did not parse"+        case filter ("query-contract " `T.isPrefixOf`) (T.lines currentLedger) of+          row : _ -> parseRecord (currentLedger <> row <> "\n") `shouldBe` Nothing+          [] -> expectationFailure "expected standalone query-contract rows"+        TIO.writeFile holePath ((.text) typedHole)+        second <- run >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure+        (.queryContractMigrations) second `shouldBe` []+        [disposition | (value, disposition) <- (.dispositions) second, value.path == typedHole.path]+          `shouldBe` [Skipped]++        changedParsed <- case parseSource "<mapped-query-drift>" (T.replace "query result = Optional ArtifactLocation" "query result = ArtifactLocation" source) of+          Left failure -> expectationFailure (show failure) >> fail "unreachable"+          Right value -> pure value+        let changedService = checkedSource changedParsed+        changedModules <- case planTestServiceScaffold ctx changedService of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right values -> pure values+        third <-+          executeServiceScaffold out False "mapped-query.keiro" ((.sourceLanguage) changedParsed) ctx changedService changedModules+            >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure+        (.queryContractDrift) third+          `shouldSatisfy` \case+            [QueryContractDrift {key = ("ArtifactLookup", QueryResultConsumer)}] -> True+            _ -> False+        renderScaffoldReport third `shouldSatisfy` any (T.isInfixOf "query contract drift: 1")++        let withoutQuerySource =+              T.unlines+                [ line+                | line <- T.lines source,+                  not ("  query input =" `T.isPrefixOf` line),+                  not ("  query result =" `T.isPrefixOf` line)+                ]+        withoutQueryParsed <- case parseSource "<mapped-query-removed>" withoutQuerySource of+          Left failure -> expectationFailure (show failure) >> fail "unreachable"+          Right value -> pure value+        let withoutQueryService = checkedSource withoutQueryParsed+        withoutQueryModules <- case planTestServiceScaffold ctx withoutQueryService of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right values -> pure values+        fourth <-+          executeServiceScaffold out False "mapped-query.keiro" ((.sourceLanguage) withoutQueryParsed) ctx withoutQueryService withoutQueryModules+            >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure+        length ((.queryContractDrift) fourth) `shouldBe` 2+        removedLedger <- TIO.readFile ((.recordPath) fourth)+        case parseRecord removedLedger of+          Just record -> do+            (.queryContractBaseline) record `shouldBe` True+            (.queryContracts) record `shouldBe` []+          Nothing -> expectationFailure "removed query-contract ledger did not parse"++    it "plans and records the same typed query contract across workspace members" $+      withTempDirectory "keiro-dsl-mapped-query-workspace" $ \out -> do+        plan <- shouldPlanWorkspace "test/fixtures/mapped-readmodel-workspace/service.keiro-workspace"+        let contractRows =+              [ (scaffoldModule, provenance)+              | (scaffoldModule, provenance) <- (.modules) plan,+                "QueryContract.hs" `T.isSuffixOf` T.pack ((.path) scaffoldModule)+              ]+        case contractRows of+          [(contract, MemberOwned owner)] -> do+            owner `shouldBe` "readmodel.keiro"+            (.text) contract `shouldSatisfy` T.isInfixOf "type AccountSummaryQueryInput = AccountLookup"+            (.text) contract `shouldSatisfy` T.isInfixOf "type AccountSummaryQueryResult = Maybe AccountSummary"+          values -> expectationFailure ("unexpected workspace query contracts: " <> show values)+        report <- executeWorkspaceScaffold out False plan >>= either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure+        (.queryContractMigrations) report `shouldBe` []+        recordText <- TIO.readFile ((.recordPath) report)+        case parseWorkspaceRecord recordText of+          Just record -> do+            (.queryContractBaseline) record `shouldBe` True+            length ((.queryContracts) record) `shouldBe` 2+          Nothing -> expectationFailure "workspace query-contract ledger did not parse"++  describe "complete mapped surfaces" $ do+    it "projects exact queue, query, event, snapshot, and replayable projection consequences" $ do+      aggregateSpec <- specOf "test/fixtures/semantic-impact.keiro"+      queueSpec <- specOf "test/fixtures/mapped-workqueue.keiro"+      querySpec <- specOf "test/fixtures/mapped-readmodel.keiro"+      projectionSpec <- specOf "test/fixtures/projection-catalog.keiro"+      let aggregateImpact = semanticImpactForSpec aggregateSpec+          queueImpact = semanticImpactForSpec queueSpec+          queryImpact = semanticImpactForSpec querySpec+          projectionImpact = semanticImpactForSpec projectionSpec+          consequences impact declaration = Map.findWithDefault Set.empty (MappedKey declaration) ((.declarationConsequences) impact)+      consequences aggregateImpact "CommandPayload"+        `shouldBe` Set.singleton (MappedConsumerBuild (AggregateConsumer "Alpha"))+      consequences aggregateImpact "EventPayload"+        `shouldBe` Set.fromList [MappedConsumerBuild (AggregateConsumer "Alpha"), MappedPrivateEventHistory "Alpha"]+      consequences aggregateImpact "RegisterPayload"+        `shouldBe` Set.fromList [MappedConsumerBuild (AggregateConsumer "Alpha"), MappedSnapshotHydration "Alpha"]+      consequences queueImpact "JobPayload"+        `shouldBe` Set.fromList [MappedConsumerBuild (WorkqueueConsumer "mapped_jobs"), MappedWorkqueueHistory "mapped_jobs"]+      consequences queryImpact "AccountLookup"+        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "account_summary" MappedQueryInput), MappedQueryApi "account_summary" MappedQueryInput]+      consequences queryImpact "AccountSummary"+        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "account_summary" MappedQueryResult), MappedQueryApi "account_summary" MappedQueryResult]+      consequences projectionImpact "OrderPayload"+        `shouldBe` Set.fromList+          [ MappedConsumerBuild (AggregateConsumer "Orders"),+            MappedPrivateEventHistory "Orders",+            MappedConsumerBuild (DerivedProjectionConsumer (CatalogProjectionConsumer "order_summary_writer" "Orders")),+            MappedProjectionHandlerReview (CatalogProjectionConsumer "order_summary_writer" "Orders"),+            MappedProjectionRebuild (CatalogProjectionConsumer "order_summary_writer" "Orders") "reporting"+          ]++    it "reports every surface independently without inventing Json or heterogeneous typed roots" $ do+      queueSpec <- specOf "test/fixtures/mapped-workqueue.keiro"+      querySpec <- specOf "test/fixtures/mapped-readmodel.keiro"+      projectionSpec <- specOf "test/fixtures/projection-catalog.keiro"+      queueCoverage <- shouldResolveCoverage "mapped-workqueue.keiro" queueSpec+      queryCoverage <- shouldResolveCoverage "mapped-readmodel.keiro" querySpec+      projectionCoverage <- shouldResolveCoverage "projection-catalog.keiro" projectionSpec+      (.workqueuePayloads) ((.summary) queueCoverage)+        `shouldBe` Coverage.CoverageCounts 2 2 0 1+      (.readModelQueryInputs) ((.summary) queryCoverage)+        `shouldBe` Coverage.CoverageCounts 1 1 0 0+      (.readModelQueryResults) ((.summary) queryCoverage)+        `shouldBe` Coverage.CoverageCounts 1 1 0 0+      (.projectionTypedConsumers) ((.summary) projectionCoverage)+        `shouldBe` Coverage.CoverageCounts 3 0 3 0+      map (.consumer) [root | root <- (.roots) queryCoverage, (.surface) root `elem` [Coverage.ReadModelQueryInput, Coverage.ReadModelQueryResult]]+        `shouldBe` ["read-model-query:account_summary:input", "read-model-query:account_summary:result"]+      map (.surface) ((.unsupportedSurfaces) projectionCoverage)+        `shouldContain` ["projection-category:audit_writer:audit"]++    it "places one deterministic surface/consumer/root/path fact set behind the service facade" $ do+      services <- mapM checkedServiceOf ["test/fixtures/mapped-workqueue.keiro", "test/fixtures/mapped-readmodel.keiro", "test/fixtures/projection-catalog.keiro"]+      let facts = concatMap serviceConformanceFactValues services+          surfaceFacts = [(key, value) | (key, value) <- facts, "mapped-surface/" `T.isPrefixOf` key]+          keys = map fst surfaceFacts+      length keys `shouldBe` Set.size (Set.fromList keys)+      keys `shouldSatisfy` any (T.isInfixOf "/workqueue-payload/workqueue:mapped_jobs/JobPayload/workqueue mapped_jobs payload .job : JobPayload")+      keys `shouldSatisfy` any (T.isInfixOf "/read-model-query-input/read-model-query:account_summary:input/AccountLookup/readmodel account_summary query input : AccountLookup")+      keys `shouldSatisfy` any (T.isInfixOf "/projection-event-consumer/catalog-projection:order_summary_writer:Orders/OrderPayload/Orders event OrderRecorded .orderPayload : OrderPayload")+      map snd surfaceFacts `shouldSatisfy` any (T.isInfixOf "workqueue-history:mapped_jobs")+      map snd surfaceFacts `shouldSatisfy` any (T.isInfixOf "projection-rebuild:catalog-projection:order_summary_writer:Orders:reporting")++    it "keeps predecessor facades byte-stable while extending the Language 5 facade" $ do+      published <- checkedServiceOf "test/fixtures/semantic-impact.keiro"+      candidate <- checkedServiceOf "test/fixtures/mapped-workqueue.keiro"+      serviceConformanceFactKeys published+        `shouldSatisfy` all (not . T.isPrefixOf "mapped-surface/")+      serviceConformanceFactKeys candidate+        `shouldSatisfy` any (T.isPrefixOf "mapped-surface/")++    it "detects replay policy and observer relation drift without fabricating mapped declaration changes" $ do+      projectionSpec <- specOf "test/fixtures/projection-catalog.keiro"+      let makeLiveOnly node = case node of+            NProjectionOwner owner@ProjectionOwnerNode {name = "order_summary_writer"} ->+              NProjectionOwner (projectionOwnerWithReplay (ProjectionLiveOnly "candidate is intentionally live-only") owner)+            other -> other+          moveObserver node = case node of+            NReadModel readModel@ReadModelNode {name = "catalogAudit"} ->+              NReadModel (readModelWithObservedTargets ["order_summary"] readModel)+            other -> other+          liveOnly = specWithNodes (map makeLiveOnly projectionSpec.nodes) projectionSpec+          observerMoved = specWithNodes (map moveObserver projectionSpec.nodes) projectionSpec+          liveDeltas = CheckedDiff.mappedSemanticImpact projectionSpec liveOnly+          observerDeltas = CheckedDiff.mappedSemanticImpact projectionSpec observerMoved+      map (.declaration) liveDeltas `shouldBe` [MappedKey "OrderPayload", MappedKey "SharedReference"]+      map (.currentConsequences) liveDeltas+        `shouldSatisfy` all (maybe False (not . any (\case MappedProjectionRebuild (CatalogProjectionConsumer "order_summary_writer" "Orders") _ -> True; _ -> False) . Set.toList))+      map (.declaration) observerDeltas `shouldBe` [MappedKey "OrderPayload", MappedKey "SharedReference"]+      map (.currentEvidence) observerDeltas+        `shouldSatisfy` any (maybe False (any (maybe False (T.isInfixOf "catalogAudit") . (.operation)) . Set.toList))+      diffMapped projectionSpec liveOnly `shouldBe` []++  describe "mapped surface ledger" $ do+    it "round-trips complete evidence, treats aggregate-only history as unknown, and rejects corrupt known tags" $ do+      spec <- specOf "test/fixtures/semantic-impact.keiro"+      let snapshot = semanticImpactSnapshotForSpec spec+          legacy = semanticImpactSnapshotWithoutEvidence snapshot+          declaration = MappedKey "EventPayload"+          report = semanticImpactReport (Just legacy) snapshot [declaration]+          encoded = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode snapshot))+          corrupt = T.replace "\"surface\":\"aggregate-command\"" "\"surface\":\"future-surface\"" encoded+      Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot+      Aeson.decode (Aeson.encode legacy) `shouldBe` Just legacy+      (.deltas) report `shouldSatisfy` \case+        [delta] -> (.previousEvidence) delta == Nothing && (.currentEvidence) delta /= Nothing+        _ -> False+      renderSemanticImpactReport report `shouldSatisfy` any (T.isInfixOf "previous roots: baseline unavailable")+      corrupt `shouldNotBe` encoded+      (Aeson.decode (LazyTextEncoding.encodeUtf8 (LazyText.fromStrict corrupt)) :: Maybe SemanticImpactSnapshot) `shouldBe` Nothing++  describe "mapped compatibility vectors" $ do+    it "keeps queue, query, event, snapshot, and projection consequences orthogonal" $ do+      queueSpec <- specOf "test/fixtures/mapped-workqueue.keiro"+      querySpec <- specOf "test/fixtures/mapped-readmodel.keiro"+      aggregateSpec <- specOf "test/fixtures/semantic-impact.keiro"+      projectionSpec <- specOf "test/fixtures/projection-catalog.keiro"+      let changeQueue node = case node of+            NWorkqueue queue ->+              NWorkqueue (workqueueWithPayload [if field.name == "job" then wqFieldWithValueType (TypedQueueExpression (TRef "JobMetadata")) field else field | field <- queue.payload] queue)+            other -> other+          queueChanged = specWithNodes (map changeQueue queueSpec.nodes) queueSpec+          changeQuery node = case node of+            NReadModel readModel@ReadModelNode {queryTypes = Just queryPair} ->+              NReadModel (readModelWithQueryTypes (Just (ReadModelQueryTypes (TRef "TenantKey") queryPair.result queryPair.inputLoc queryPair.resultLoc)) readModel)+            other -> other+          queryChanged = specWithNodes (map changeQuery querySpec.nodes) querySpec+          findKind predicate changes = case [kindOfChange change | change <- changes, predicate (kindOfChange change)] of+            value : _ -> value+            [] -> error "expected mapped compatibility finding"+          queueKind = findKind ((== WqPayloadFieldChanged) . (.code)) (diffSpecs queueSpec queueChanged)+          queryKind = findKind ((== ReadModelQueryInputChanged) . (.code)) (diffSpecs querySpec queryChanged)+          eventKind = findKind ((== "mapped-event") . (.facet)) [change | mutation <- mappedWireMutations aggregateSpec, change <- diffSpecs aggregateSpec ((.mmCandidate) mutation)]+          snapshotKind = findKind ((== "mapped-register") . (.facet)) [change | mutation <- mappedWireMutations aggregateSpec, change <- diffSpecs aggregateSpec ((.mmCandidate) mutation)]+          projectionChanged = mapMappedDeclaration "OrderPayload" changeProjectionMappedWire projectionSpec+          projectionKind = findKind ((== "mapped-projection") . (.facet)) (diffSpecs projectionSpec projectionChanged)+      (.mappedConsequences) queueKind+        `shouldBe` Set.fromList [MappedConsumerBuild (WorkqueueConsumer "mapped_jobs"), MappedWorkqueueHistory "mapped_jobs"]+      (.privateHistoryRead) (queueKind.vector) `shouldBe` VNotApplicable+      (.consumerBuild) (queueKind.vector) `shouldBe` VBreaking+      (.mappedConsequences) queryKind+        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "account_summary" MappedQueryInput), MappedQueryApi "account_summary" MappedQueryInput]+      (.snapshotHydration) (queryKind.vector) `shouldBe` VNotApplicable+      (.mappedConsequences) eventKind `shouldSatisfy` Set.member (MappedPrivateEventHistory "Alpha")+      (.mappedConsequences) snapshotKind `shouldSatisfy` Set.member (MappedSnapshotHydration "Alpha")+      (.mappedConsequences) projectionKind `shouldSatisfy` Set.member (MappedProjectionHandlerReview (CatalogProjectionConsumer "order_summary_writer" "Orders"))+      (.mappedConsequences) projectionKind+        `shouldSatisfy` Set.member (MappedProjectionRebuild (CatalogProjectionConsumer "order_summary_writer" "Orders") "reporting")++  describe "mapped surface qualification" $ do+    it "selects every explicit and derived surface from one integrated Language 5 authority" $ do+      service <- checkedServiceOf "test/fixtures/projection-catalog.keiro"+      workspace <- shouldComposeWorkspace "test/fixtures/projection-catalog.keiro-workspace"+      coverage <- shouldResolveCoverage "projection-catalog.keiro" (checkedSpec service)+      let impact = semanticImpactForSpec (checkedSpec service)+          qualify name = qualifyMappedSurface impact (MappedKey name)+          orderPayload = qualify "OrderPayload"+          sharedReference = qualify "SharedReference"+          qualificationPayload = qualify "QualificationPayload"+          queueMetadata = qualify "QueueMetadata"+          queryCriteria = qualify "QueryCriteria"+          qualificationResult = qualify "QualificationResult"+          registerState = qualify "RegisterState"+          unused = qualify "UnusedQualification"+          standaloneSnapshot = semanticImpactSnapshot impact+      standaloneSnapshot `shouldBe` semanticImpactSnapshotForSpec ((.mergedSpec) workspace)+      Aeson.decode (Aeson.encode standaloneSnapshot) `shouldBe` Just standaloneSnapshot+      (.consumers) orderPayload+        `shouldBe` Set.fromList+          [ AggregateConsumer "Orders",+            DerivedProjectionConsumer (CatalogProjectionConsumer "order_summary_writer" "Orders")+          ]+      Set.map (.rootKind) ((.evidence) orderPayload)+        `shouldBe` Set.fromList [MappedCommandFieldRoot, MappedEventFieldRoot, MappedProjectionEventRoot]+      (.consequences) orderPayload+        `shouldSatisfy` Set.member (MappedProjectionRebuild (CatalogProjectionConsumer "order_summary_writer" "Orders") "reporting")+      (.consumers) sharedReference+        `shouldBe` Set.fromList+          [ AggregateConsumer "Orders",+            AggregateConsumer "Shipments",+            WorkqueueConsumer "qualification_jobs",+            DerivedProjectionConsumer (CatalogProjectionConsumer "order_summary_writer" "Orders"),+            DerivedProjectionConsumer (CatalogProjectionConsumer "shipment_writer" "Shipments")+          ]+      (.consumers) qualificationPayload `shouldBe` Set.singleton (WorkqueueConsumer "qualification_jobs")+      (.consequences) qualificationPayload+        `shouldBe` Set.fromList [MappedConsumerBuild (WorkqueueConsumer "qualification_jobs"), MappedWorkqueueHistory "qualification_jobs"]+      (.consumers) queueMetadata `shouldBe` Set.singleton (WorkqueueConsumer "qualification_jobs")+      (.consumers) queryCriteria `shouldBe` Set.singleton (ReadModelQueryConsumer "order_inline" MappedQueryInput)+      (.consequences) queryCriteria+        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "order_inline" MappedQueryInput), MappedQueryApi "order_inline" MappedQueryInput]+      (.consumers) qualificationResult `shouldBe` Set.singleton (ReadModelQueryConsumer "order_inline" MappedQueryResult)+      (.consequences) qualificationResult+        `shouldBe` Set.fromList [MappedConsumerBuild (ReadModelQueryConsumer "order_inline" MappedQueryResult), MappedQueryApi "order_inline" MappedQueryResult]+      (.consumers) registerState `shouldBe` Set.singleton (AggregateConsumer "Orders")+      (.consequences) registerState+        `shouldBe` Set.fromList [MappedConsumerBuild (AggregateConsumer "Orders"), MappedSnapshotHydration "Orders"]+      (.consumers) unused `shouldBe` Set.empty+      (.evidence) unused `shouldBe` Set.empty+      (.consequences) unused `shouldBe` Set.empty+      (.workqueuePayloads) ((.summary) coverage) `shouldBe` Coverage.CoverageCounts 4 1 3 1+      (.readModelQueryInputs) ((.summary) coverage) `shouldBe` Coverage.CoverageCounts 1 0 1 0+      (.readModelQueryResults) ((.summary) coverage) `shouldBe` Coverage.CoverageCounts 1 0 1 0+      (.projectionTypedConsumers) ((.summary) coverage) `shouldBe` Coverage.CoverageCounts 3 0 3 0+      map (.surface) ((.unsupportedSurfaces) coverage)+        `shouldContain` ["projection-category:audit_writer:audit"]++    it "aligns every mapping diff with the authority's exact consequence set" $ do+      service <- checkedServiceOf "test/fixtures/projection-catalog.keiro"+      let spec = checkedSpec service+          impact = semanticImpactForSpec spec+          opaqueMutation name = mapMappedDeclaration name changeProjectionMappedWire spec+          mutations =+            [ ("OrderPayload", opaqueMutation "OrderPayload"),+              ("SharedReference", opaqueMutation "SharedReference"),+              ("QualificationPayload", addMappedOptionalTextField "QualificationPayload" "addedNote" spec),+              ("QueueMetadata", opaqueMutation "QueueMetadata"),+              ("QueryCriteria", opaqueMutation "QueryCriteria"),+              ("QualificationResult", opaqueMutation "QualificationResult"),+              ("RegisterState", opaqueMutation "RegisterState"),+              ("UnusedQualification", opaqueMutation "UnusedQualification")+            ]+          actualConsequences candidate =+            Set.unions+              [ (.mappedConsequences) (kindOfChange change)+              | change <- diffServices service (checkedServiceWithSpec candidate service)+              ]+          expectedConsequences name = (.consequences) (qualifyMappedSurface impact (MappedKey name))+      forM_ mutations $ \(name, candidate) ->+        actualConsequences candidate `shouldBe` expectedConsequences name++    it "pins exact generated locality and keeps it constant under unrelated workspace growth" $ do+      service <- checkedServiceOf "test/fixtures/projection-catalog.keiro"+      grown <- shouldComposeWorkspace "test/fixtures/projection-catalog-grown.keiro-workspace"+      let spec = checkedSpec service+          ctx = defaultContext (spec.context)+          baseline = scaffoldServiceModules ctx service+          modulesFor candidate = scaffoldServiceModules ctx (checkedServiceWithSpec candidate service)+          deltaFor candidate = generatedTreeDelta baseline (modulesFor candidate)+          opaqueDelta name = deltaFor (mapMappedDeclaration name changeProjectionMappedWire spec)+          structuralDelta = deltaFor (addMappedOptionalTextField "QualificationPayload" "addedNote" spec)+          structuralPaths =+            Set.fromList+              [ "Generated/CatalogDemo/QualificationJobs/Queue.hs",+                "Generated/CatalogDemo/Structural/Shape/QualificationPayload.hs",+                "Generated/CatalogDemo/StructuralConformance.hs"+              ]+          projectionPaths =+            Set.fromList+              [ "Generated/CatalogDemo/ProjectionCatalog.hs",+                "Generated/CatalogDemo/StructuralConformance.hs"+              ]+          registerPaths =+            Set.fromList+              [ "Generated/CatalogDemo/Orders/Transducer.hs",+                "Generated/CatalogDemo/StructuralConformance.hs"+              ]+          serviceOnly = Set.singleton "Generated/CatalogDemo/StructuralConformance.hs"+          assertExact delta paths = do+            (.changedPaths) delta `shouldBe` paths+            (.addedPaths) delta `shouldBe` Set.empty+            (.removedPaths) delta `shouldBe` Set.empty+      assertExact structuralDelta structuralPaths+      assertExact (opaqueDelta "OrderPayload") projectionPaths+      assertExact (opaqueDelta "SharedReference") projectionPaths+      assertExact (opaqueDelta "RegisterState") registerPaths+      forM_ ["QueueMetadata", "QueryCriteria", "QualificationResult", "UnusedQualification"] $ \name ->+        assertExact (opaqueDelta name) serviceOnly+      let grownCandidate = mapWorkspaceSpec (mapMappedDeclaration "OrderPayload" changeProjectionMappedWire) grown+      grownBaselinePlan <- shouldPlanWorkspaceSpec grown+      grownCandidatePlan <- shouldPlanWorkspaceSpec grownCandidate+      let grownDelta = generatedTreeDelta (map fst ((.modules) grownBaselinePlan)) (map fst ((.modules) grownCandidatePlan))+      (.changedPaths) grownDelta `shouldBe` (.changedPaths) (opaqueDelta "OrderPayload")+      (.addedPaths) grownDelta `shouldBe` Set.empty+      (.removedPaths) grownDelta `shouldBe` Set.empty++    it "keeps Language 5 syntax gated and predecessor service facades unchanged" $ do+      candidate <- checkedServiceOf "test/fixtures/projection-catalog.keiro"+      published <- checkedServiceOf "test/fixtures/consumer-types.keiro"+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      let candidateKeys = serviceConformanceFactKeys candidate+          candidateValues = map snd (serviceConformanceFactValues candidate)+      candidateKeys `shouldSatisfy` any (T.isPrefixOf "mapped-surface/")+      length candidateKeys `shouldBe` Set.size (Set.fromList candidateKeys)+      candidateValues `shouldSatisfy` any (T.isInfixOf "workqueue-history:qualification_jobs")+      candidateValues `shouldSatisfy` any (T.isInfixOf "query-api:order_inline:input")+      candidateValues `shouldSatisfy` any (T.isInfixOf "projection-handler-review:catalog-projection:order_summary_writer:Orders")+      serviceConformanceFactKeys published `shouldSatisfy` all (not . T.isPrefixOf "mapped-surface/")+      parseSource "<published-mapped-surfaces>" (T.replace "language keiro-dsl 5" "language keiro-dsl 4" source)+        `shouldSatisfy` isLeft++  describe "language support" $ do+    it "serializes support from the registered version and decodes older records" $ do+      v1Contract <- maybe (expectationFailure "missing v1 contract" >> fail "unreachable") pure (effectiveLanguageContractForVersion =<< languageVersion 1)+      v4Contract <- maybe (expectationFailure "missing v4 contract" >> fail "unreachable") pure (effectiveLanguageContractForVersion =<< languageVersion 4)+      v5Contract <- maybe (expectationFailure "missing v5 contract" >> fail "unreachable") pure (effectiveLanguageContractForVersion =<< languageVersion 5)+      effectiveLanguageSupport v1Contract `shouldBe` CompatibilityOnly+      effectiveLanguageSupport v4Contract `shouldBe` CompatibilityOnly+      effectiveLanguageSupport v5Contract `shouldBe` Stable+      Aeson.toJSON v5Contract+        `shouldBe` object+          [ "languageVersion" .= (5 :: Int),+            "runtimeSemantics" .= ("keiro-dsl/runtime-semantics/4" :: T.Text),+            "languageSupport" .= ("stable" :: T.Text)+          ]+      Aeson.eitherDecode "{\"languageVersion\":1,\"runtimeSemantics\":\"keiro-dsl/runtime-semantics/1\"}"+        `shouldBe` Right v1Contract++    it "reports stable and compatibility-only support through source inspection" $ do+      (stableCode, stableOut, stableErr) <- runKeiroDsl ["inspect", "test/fixtures/projection-catalog.keiro", "--format=json"]+      stableCode `shouldBe` ExitSuccess+      stableErr `shouldBe` ""+      stableOut `shouldContain` "\"languageVersion\":5"+      stableOut `shouldContain` "\"languageSupport\":\"stable\""+      (predecessorCode, predecessorOut, predecessorErr) <- runKeiroDsl ["inspect", "test/fixtures/contract-v4.keiro", "--format=json"]+      predecessorCode `shouldBe` ExitSuccess+      predecessorErr `shouldBe` ""+      predecessorOut `shouldContain` "\"languageVersion\":4"+      predecessorOut `shouldContain` "\"languageSupport\":\"compatibility-only\""+      (compatibilityCode, compatibilityOut, compatibilityErr) <- runKeiroDsl ["inspect", "test/fixtures/language-v1.keiro", "--format=json"]+      compatibilityCode `shouldBe` ExitSuccess+      compatibilityErr `shouldBe` ""+      compatibilityOut `shouldContain` "\"languageVersion\":1"+      compatibilityOut `shouldContain` "\"languageSupport\":\"compatibility-only\""++    it "surfaces non-stable contracts and enforces a released minimum language" $ do+      let legacyPath = "test/fixtures/language-legacy.keiro"+          stablePath = "test/fixtures/projection-catalog.keiro"+      (legacyCode, legacyOut, legacyErr) <- runKeiroDsl ["check", legacyPath]+      legacyCode `shouldBe` ExitSuccess+      legacyOut `shouldBe` "OK\n"+      legacyErr `shouldContain` "language contract: effective keiro-dsl 1 (legacy-unversioned, compatibility-only, runtime semantics keiro-dsl/runtime-semantics/1)"+      legacyErr `shouldContain` "language-5 strict spec-surface validation is not applied"++      (stableCode, stableOut, stableErr) <- runKeiroDsl ["check", stablePath]+      stableCode `shouldBe` ExitSuccess+      stableOut `shouldBe` "OK\n"+      stableErr `shouldBe` ""++      (floorCode, floorOut, floorErr) <- runKeiroDsl ["check", legacyPath, "--min-language", "4"]+      floorCode `shouldBe` ExitFailure 1+      floorOut `shouldBe` ""+      floorErr `shouldContain` "language-legacy.keiro:1: error[LanguageVersionBelowMinimum]"+      floorErr `shouldContain` "effective language version 1 (legacy-unversioned) is below the required minimum 4"++      (metCode, metOut, _) <- runKeiroDsl ["check", legacyPath, "--min-language", "1"]+      metCode `shouldBe` ExitSuccess+      metOut `shouldBe` "OK\n"++      (unsupportedCode, _, unsupportedErr) <- runKeiroDsl ["check", legacyPath, "--min-language", "9"]+      unsupportedCode `shouldBe` ExitFailure 1+      unsupportedErr `shouldContain` "supported versions: 1, 2, 3, 4, 5"++    it "attributes a workspace language floor to its manifest and every member" $ do+      let v1Member = T.unlines ["language keiro-dsl 1", "context language-floor"]+      withInlineWorkspace+        "keiro-dsl-language-floor"+        ( "language-floor",+          [ ("domain/a.keiro", v1Member),+            ("domain/b.keiro", v1Member)+          ]+        )+        $ \root _ _ -> do+          let manifest = root </> "service.keiro-workspace"+          (floorCode, floorOut, floorErr) <- runKeiroDsl ["check", manifest, "--min-language", "4"]+          floorCode `shouldBe` ExitFailure 1+          floorOut `shouldBe` ""+          floorErr `shouldContain` (manifest <> ":1: error[LanguageVersionBelowMinimum]")+          floorErr `shouldContain` "domain/a.keiro:1: note: member selects effective language version 1"+          floorErr `shouldContain` "domain/b.keiro:1: note: member selects effective language version 1"+          floorErr `shouldContain` "workspace, 0 legacy-unversioned member(s)"++          (metCode, metOut, _) <- runKeiroDsl ["check", manifest, "--min-language", "1"]+          metCode `shouldBe` ExitSuccess+          metOut `shouldBe` "OK\n"++  describe "warning enforcement" $ do+    it "round-trips every stable diagnostic code spelling" $ do+      forM_ [minBound .. maxBound] $ \diagnosticCode ->+        parseDiagnosticCode (diagnosticCodeText diagnosticCode) `shouldBe` Just diagnosticCode++    it "fails only the warnings selected by invocation policy" $ do+      let fixture = "test/fixtures/deny-unlogged.keiro"+          warningText = "warning[WqUnloggedDurability]"+          summaryText = "check: 1 warning(s) escalated to failure (denied: WqUnloggedDurability)"++      (plainCode, plainOut, plainErr) <- runKeiroDsl ["check", fixture]+      plainCode `shouldBe` ExitSuccess+      plainOut `shouldBe` "OK\n"+      plainErr `shouldContain` warningText+      plainErr `shouldNotContain` "escalated to failure"++      (allCode, allOut, allErr) <- runKeiroDsl ["check", fixture, "--deny-warnings"]+      allCode `shouldBe` ExitFailure 1+      allOut `shouldBe` ""+      allErr `shouldContain` warningText+      allErr `shouldContain` summaryText++      (selectedCode, selectedOut, selectedErr) <- runKeiroDsl ["check", fixture, "--deny", "WqUnloggedDurability"]+      selectedCode `shouldBe` ExitFailure 1+      selectedOut `shouldBe` ""+      selectedErr `shouldContain` warningText+      selectedErr `shouldContain` summaryText++      (otherCode, otherOut, otherErr) <- runKeiroDsl ["check", fixture, "--deny", "WireSchemaVersionMismatch"]+      otherCode `shouldBe` ExitSuccess+      otherOut `shouldBe` "OK\n"+      otherErr `shouldContain` warningText+      otherErr `shouldNotContain` "escalated to failure"++      (unionCode, unionOut, unionErr) <-+        runKeiroDsl+          [ "check",+            fixture,+            "--deny-warnings",+            "--deny",+            "WireSchemaVersionMismatch,WqUnloggedDurability"+          ]+      unionCode `shouldBe` ExitFailure 1+      unionOut `shouldBe` ""+      unionErr `shouldContain` warningText+      unionErr `shouldContain` summaryText++      (unknownCode, _, unknownErr) <- runKeiroDsl ["check", fixture, "--deny", "NotACode"]+      unknownCode `shouldBe` ExitFailure 1+      unknownErr `shouldContain` "unknown diagnostic code `NotACode`"+      unknownErr `shouldContain` "warning[Code]"++    -- A denial that can never match reads like a CI gate and is not one. Every+    -- code `check` cannot emit is refused at the point of use instead.+    it "refuses a denial of a code check can never emit" $ do+      let fixture = "test/fixtures/deny-unlogged.keiro"++      (diffCode, _, diffErr) <- runKeiroDsl ["check", fixture, "--deny", "EvtFieldWireKeyChanged"]+      diffCode `shouldBe` ExitFailure 1+      diffErr `shouldContain` "`EvtFieldWireKeyChanged` is emitted by `keiro-dsl diff`"+      diffErr `shouldContain` "would never match"++      -- Rejection survives being hidden inside a comma-separated list.+      (mixedCode, _, mixedErr) <-+        runKeiroDsl ["check", fixture, "--deny", "WqUnloggedDurability,WorkflowShapeChanged"]+      mixedCode `shouldBe` ExitFailure 1+      mixedErr `shouldContain` "`WorkflowShapeChanged` is emitted by `keiro-dsl diff`"++      (codecCode, _, codecErr) <- runKeiroDsl ["check", fixture, "--deny", "CodecCompareDifference"]+      codecCode `shouldBe` ExitFailure 1+      codecErr `shouldContain` "generated codec-comparison path"++      -- A coverage code is emittable, but only by an invocation that asks for+      -- the coverage pass, so the requirement is stated rather than ignored.+      (noPassCode, _, noPassErr) <- runKeiroDsl ["check", fixture, "--deny", "CoverageOpaqueSurface"]+      noPassCode `shouldBe` ExitFailure 1+      noPassErr `shouldContain` "add --coverage-report FILE or drop the code"++      -- CoverageOpaqueGateExceeded is the error --fail-on-opaque itself raises,+      -- never a warning, so denying it is a silent no-op in every invocation —+      -- with or without the coverage pass it is refused with the real spelling.+      withTempDirectory "keiro-dsl-gate-exceeded-deny" $ \out -> do+        (gateCode, _, gateErr) <-+          runKeiroDsl+            ["check", fixture, "--coverage-report", out </> "coverage.json", "--deny", "CoverageOpaqueGateExceeded"]+        gateCode `shouldBe` ExitFailure 1+        gateErr `shouldContain` "pass --fail-on-opaque instead of denying it"+      (gateNoPassCode, _, gateNoPassErr) <- runKeiroDsl ["check", fixture, "--deny", "CoverageOpaqueGateExceeded"]+      gateNoPassCode `shouldBe` ExitFailure 1+      gateNoPassErr `shouldContain` "pass --fail-on-opaque instead of denying it"++    it "applies the warning policy to structural-coverage findings" $ do+      withTempDirectory "keiro-dsl-coverage-deny" $ \out -> do+        let fixture = "test/fixtures/structural-conformance.keiro"+            coveragePath = out </> "coverage.json"+            reportPath = out </> "nested" </> "dir" </> "check.json"+            warningText = "warning[CoverageOpaqueSurface]"++        -- Reporting-only by default: the finding prints and the check passes.+        (plainCode, _, plainErr) <-+          runKeiroDsl ["check", fixture, "--coverage-report", coveragePath]+        plainCode `shouldBe` ExitSuccess+        plainErr `shouldContain` warningText+        plainErr `shouldNotContain` "escalated to failure"++        -- Before ExecPlan 199 this combination exited 0 with the warning printed.+        (deniedCode, _, deniedErr) <-+          runKeiroDsl+            [ "check",+              fixture,+              "--coverage-report",+              coveragePath,+              "--deny-warnings",+              -- The nested path also proves --report-out creates parent dirs.+              "--report-out",+              reportPath+            ]+        deniedCode `shouldBe` ExitFailure 1+        deniedErr `shouldContain` warningText+        deniedErr `shouldContain` "escalated to failure (denied: CoverageOpaqueSurface)"++        report <- decodeJsonValue reportPath+        jsonField "ok" report `shouldBe` Just (Aeson.Bool False)+        (jsonField "summary" report >>= jsonField "deniedWarnings") `shouldBe` Just (Aeson.Number 1)+        case jsonField "diagnostics" report of+          Just (Aeson.Array entries) ->+            [entry | entry <- toList entries, jsonField "code" entry == Just (Aeson.String "CoverageOpaqueSurface")]+              `shouldSatisfy` \matching -> case matching of+                entry : _ ->+                  jsonField "severity" entry == Just (Aeson.String "warning")+                    && jsonField "denied" entry == Just (Aeson.Bool True)+                [] -> False+          other -> expectationFailure ("expected diagnostics array, got " <> show other)++        -- Selecting the code by name gates it just as precisely.+        (selectedCode, _, _) <-+          runKeiroDsl+            ["check", fixture, "--coverage-report", coveragePath, "--deny", "CoverageOpaqueSurface"]+        selectedCode `shouldBe` ExitFailure 1++    it "spells warning severity the same way in both JSON reports" $ do+      withTempDirectory "keiro-dsl-severity-vocabulary" $ \out -> do+        let coveragePath = out </> "coverage.json"+        (exitCode, _, _) <-+          runKeiroDsl+            ["check", "test/fixtures/structural-conformance.keiro", "--coverage-report", coveragePath]+        exitCode `shouldBe` ExitSuccess+        coverage <- decodeJsonValue coveragePath+        case jsonField "findings" coverage of+          Just (Aeson.Array entries) -> case toList entries of+            entry : _ -> jsonField "severity" entry `shouldBe` Just (Aeson.String "warning")+            [] -> expectationFailure "coverage report had no findings"+          other -> expectationFailure ("expected findings array, got " <> show other)++    it "writes the machine report when a workspace is refused during composition" $ do+      withTempDirectory "keiro-dsl-workspace-refusal-report" $ \out -> do+        let reportPath = out </> "made" </> "up" </> "refusal.json"+        (exitCode, stdoutText, _) <-+          runKeiroDsl+            [ "check",+              "test/fixtures/workspace-dup-decl/service.keiro-workspace",+              "--report-out",+              reportPath+            ]+        exitCode `shouldBe` ExitFailure 1+        stdoutText `shouldBe` ""+        report <- decodeJsonValue reportPath+        jsonField "schema" report `shouldBe` Just (Aeson.String "keiro-dsl/check-report/1")+        jsonField "kind" report `shouldBe` Just (Aeson.String "workspace")+        jsonField "ok" report `shouldBe` Just (Aeson.Bool False)+        -- No service graph was composed, so there is no language contract.+        jsonField "language" report `shouldBe` Just Aeson.Null+        case jsonField "diagnostics" report of+          Just (Aeson.Array entries) -> case toList entries of+            entry : _ -> do+              jsonField "code" entry `shouldBe` Just (Aeson.String "WorkspaceDuplicateDeclaration")+              jsonField "severity" entry `shouldBe` Just (Aeson.String "error")+            [] -> expectationFailure "workspace refusal report had no diagnostics"+          other -> expectationFailure ("expected diagnostics array, got " <> show other)++    it "applies the same warning policy to a composed workspace" $ do+      warningSource <- readTestText "test/fixtures/deny-unlogged.keiro"+      withInlineWorkspace+        "keiro-dsl-warning-policy"+        ("warning-policy", [("domain/jobs.keiro", warningSource)])+        $ \root _ _ -> do+          let manifest = root </> "service.keiro-workspace"+          (plainCode, plainOut, plainErr) <- runKeiroDsl ["check", manifest]+          plainCode `shouldBe` ExitSuccess+          plainOut `shouldBe` "OK\n"+          plainErr `shouldContain` "domain/jobs.keiro:4: warning[WqUnloggedDurability]"++          (deniedCode, deniedOut, deniedErr) <- runKeiroDsl ["check", manifest, "--deny", "WqUnloggedDurability"]+          deniedCode `shouldBe` ExitFailure 1+          deniedOut `shouldBe` ""+          deniedErr `shouldContain` "domain/jobs.keiro:4: warning[WqUnloggedDurability]"+          deniedErr `shouldContain` "check: 1 warning(s) escalated to failure (denied: WqUnloggedDurability)"++  describe "check report" $ do+    it "writes exact check report JSON bytes and retains semantic assertions" $ do+      withTempDirectory "keiro-dsl-check-report-floor" $ \out -> do+        let reportPath = out </> "report.json"+        (exitCode, stdoutText, _) <-+          runKeiroDsl+            [ "check",+              "test/fixtures/language-legacy.keiro",+              "--min-language",+              "4",+              "--report-out",+              reportPath+            ]+        exitCode `shouldBe` ExitFailure 1+        stdoutText `shouldBe` ""+        reportBytes <- BS.readFile reportPath+        assertMatchesByteGolden "test/fixtures/check-report/legacy-min-language.golden.json" reportBytes+        report <- decodeJsonValue reportPath+        jsonField "schema" report `shouldBe` Just (Aeson.String "keiro-dsl/check-report/1")+        jsonField "kind" report `shouldBe` Just (Aeson.String "source")+        jsonField "ok" report `shouldBe` Just (Aeson.Bool False)+        (jsonField "language" report >>= jsonField "stable") `shouldBe` Just (Aeson.Bool False)+        (jsonField "summary" report >>= jsonField "errors") `shouldBe` Just (Aeson.Number 1)+        case jsonField "diagnostics" report of+          Just (Aeson.Array entries) -> case toList entries of+            entry : _ -> do+              jsonField "code" entry `shouldBe` Just (Aeson.String "LanguageVersionBelowMinimum")+              jsonField "severity" entry `shouldBe` Just (Aeson.String "error")+              jsonField "line" entry `shouldBe` Just (Aeson.Number 1)+            [] -> expectationFailure "check report had no diagnostics"+          other -> expectationFailure ("expected diagnostics array, got " <> show other)++    it "marks denied warnings without changing their severity" $ do+      withTempDirectory "keiro-dsl-check-report-deny" $ \out -> do+        let deniedPath = out </> "denied.json"+            allowedPath = out </> "allowed.json"+            fixture = "test/fixtures/deny-unlogged.keiro"+        (deniedCode, _, _) <- runKeiroDsl ["check", fixture, "--deny-warnings", "--report-out", deniedPath]+        deniedCode `shouldBe` ExitFailure 1+        deniedReport <- decodeJsonValue deniedPath+        jsonField "ok" deniedReport `shouldBe` Just (Aeson.Bool False)+        (jsonField "summary" deniedReport >>= jsonField "deniedWarnings") `shouldBe` Just (Aeson.Number 1)+        case jsonField "diagnostics" deniedReport of+          Just (Aeson.Array entries) -> case toList entries of+            entry : _ -> do+              jsonField "severity" entry `shouldBe` Just (Aeson.String "warning")+              jsonField "denied" entry `shouldBe` Just (Aeson.Bool True)+            [] -> expectationFailure "denied-warning report had no diagnostics"+          other -> expectationFailure ("expected diagnostics array, got " <> show other)++        (allowedCode, _, _) <- runKeiroDsl ["check", fixture, "--report-out", allowedPath]+        allowedCode `shouldBe` ExitSuccess+        allowedReport <- decodeJsonValue allowedPath+        jsonField "ok" allowedReport `shouldBe` Just (Aeson.Bool True)+        (jsonField "summary" allowedReport >>= jsonField "deniedWarnings") `shouldBe` Just (Aeson.Number 0)+        case jsonField "diagnostics" allowedReport of+          Just (Aeson.Array entries) -> case toList entries of+            entry : _ -> jsonField "denied" entry `shouldBe` Just (Aeson.Bool False)+            [] -> expectationFailure "allowed-warning report had no diagnostics"+          other -> expectationFailure ("expected diagnostics array, got " <> show other)++    it "reports canonical workspace members and writes nothing before parse success" $ do+      withTempDirectory "keiro-dsl-check-report-workspace" $ \out -> do+        let workspacePath = out </> "workspace.json"+            parseFailurePath = out </> "parse-failure.json"+            unregisteredPath = out </> "language-unregistered.keiro"+        (workspaceCode, _, _) <- runKeiroDsl ["check", canonicalWorkspacePath, "--report-out", workspacePath]+        workspaceCode `shouldBe` ExitSuccess+        workspaceReport <- decodeJsonValue workspacePath+        jsonField "kind" workspaceReport `shouldBe` Just (Aeson.String "workspace")+        jsonField "ok" workspaceReport `shouldBe` Just (Aeson.Bool True)+        (jsonField "language" workspaceReport >>= jsonField "sourceForm") `shouldBe` Just (Aeson.String "workspace-composed")+        case jsonField "members" workspaceReport of+          Just (Aeson.Array members) -> length members `shouldBe` 3+          other -> expectationFailure ("expected members array, got " <> show other)++        let v1Member = T.unlines ["language keiro-dsl 1", "context report-floor"]+        withInlineWorkspace+          "keiro-dsl-check-report-workspace-floor"+          ( "report-floor",+            [ ("domain/a.keiro", v1Member),+              ("domain/b.keiro", v1Member)+            ]+          )+          $ \root _ _ -> do+            let manifest = root </> "service.keiro-workspace"+                floorReportPath = out </> "workspace-floor.json"+            (floorCode, _, _) <-+              runKeiroDsl ["check", manifest, "--min-language", "4", "--report-out", floorReportPath]+            floorCode `shouldBe` ExitFailure 1+            floorReport <- decodeJsonValue floorReportPath+            case jsonField "diagnostics" floorReport of+              Just (Aeson.Array entries) -> case toList entries of+                entry : _ -> do+                  jsonField "file" entry `shouldBe` Just (Aeson.String (T.pack manifest))+                  jsonField "code" entry `shouldBe` Just (Aeson.String "LanguageVersionBelowMinimum")+                  case jsonField "related" entry of+                    Just (Aeson.Array related) -> length related `shouldBe` 2+                    other -> expectationFailure ("expected related-location array, got " <> show other)+                [] -> expectationFailure "workspace-floor report had no diagnostics"+              other -> expectationFailure ("expected diagnostics array, got " <> show other)++        TIO.writeFile unregisteredPath "language keiro-dsl 999999\nthis is intentionally not valid body syntax\n"+        (parseCode, _, _) <-+          runKeiroDsl+            [ "check",+              unregisteredPath,+              "--report-out",+              parseFailurePath+            ]+        parseCode `shouldBe` ExitFailure 1+        doesFileExist parseFailurePath `shouldReturn` False++  describe "runtime capability and fold identity baseline (plan 181)" $ do+    it "pins the fold-only FNV-1a-128 UTF-8 encoding" $ do+      foldFingerprint128 "" `shouldBe` "6c62272e07bb014262b821756295c58d"+      foldFingerprint128 "雪" `shouldBe` "a68afaae758b5822836dbc787bb233bd"++    it "pins complete fold surfaces and fingerprints across representative aggregates" $ do+      scalar <- checkedServiceOf "test/fixtures/aggregate-scalar-expressions-v2.keiro"+      nominal <- checkedServiceOf "test/fixtures/nominal-scalars.keiro"+      idDomain <- checkedServiceOf "test/fixtures/id-domain-migration-v3.keiro"+      behavior <- checkedServiceOf "test/fixtures/behavior-complete.keiro"+      workspace <- shouldComposeWorkspace "test/fixtures/workspace-nominals/service.keiro-workspace"+      let actual =+            T.intercalate+              "\n\n"+              [ renderFoldBaseline "aggregate-scalar-expressions-v2" scalar,+                renderFoldBaseline "nominal-scalars" nominal,+                renderFoldBaseline "id-domain-migration-v3" idDomain,+                renderFoldBaseline "behavior-complete" behavior,+                renderFoldBaseline "workspace-nominals" (checkedWorkspace workspace)+              ]+      assertMatchesGolden "test/fixtures/fold-identity-baseline.golden" actual++    it "pins all four runtime gates and fingerprint segment projections" $ do+      nominalSpec <- specOf "test/fixtures/id-domain-migration-v3.keiro"+      nominalRegistry <- case resolveNominalTypes nominalSpec of+        Left errors -> expectationFailure (show errors) >> fail "unreachable"+        Right value -> pure value+      nominal <- case lookupNominalType "OrderId" nominalRegistry of+        Nothing -> expectationFailure "missing OrderId nominal" >> fail "unreachable"+        Just value -> pure value+      strictSpec <-+        parseInlineSpec+          "<strict-profile>"+          ( T.unlines+              [ "context strict-profile",+                "aggregate DuplicateRegister",+                "  regs",+                "    value Int = 0",+                "    value Int = 0",+                "  states Open"+              ]+          )+      rows <- forM [1 .. 4 :: Int] $ \number -> do+        contract <- case languageVersion (fromIntegral number) >>= effectiveLanguageContractForVersion of+          Nothing -> expectationFailure ("missing released language contract " <> show number) >> fail "unreachable"+          Just value -> pure value+        let hasAggregateIdDomain = maybe False (const True) (idDomainContractFor contract "ord")+            hasContractIdDomain = maybe False (const True) (contractIdDomainContractFor contract "ord")+            nominalContract = (.contractVersion) <$> nominalEqualityContractForService contract nominal+            strictService = checkedServiceForContract contract strictSpec+            hasStrictValidation = any ((== AggregateDuplicateRegister) . (.code)) (validateService strictService)+        pure+          ( number,+            effectiveRuntimeSemantics contract,+            runtimeSemanticsFingerprintSegments contract,+            hasAggregateIdDomain,+            hasContractIdDomain,+            nominalContract,+            hasStrictValidation+          )+      rows+        `shouldBe` [ (1, "keiro-dsl/runtime-semantics/1", [], False, False, Just "keiro-dsl/nominal-equality/1", False),+                     (2, "keiro-dsl/runtime-semantics/1", [], False, False, Just "keiro-dsl/nominal-equality/1", False),+                     (3, "keiro-dsl/runtime-semantics/2", ["semantic-contract:keiro-dsl/runtime-semantics/2"], True, False, Just "keiro-dsl/nominal-equality/2", False),+                     (4, "keiro-dsl/runtime-semantics/3", ["semantic-contract:keiro-dsl/runtime-semantics/2"], True, True, Just "keiro-dsl/nominal-equality/2", True)+                   ]++    it "explains a serialized runtime-profile mismatch" $ do+      case (Aeson.eitherDecode "{\"languageVersion\":4,\"runtimeSemantics\":\"keiro-dsl/runtime-semantics/2\"}" :: Either String EffectiveLanguageContract) of+        Left message -> do+          message `shouldContain` "runtimeSemantics does not match language version 4"+          message `shouldContain` "keiro-dsl/runtime-semantics/3"+          message `shouldContain` "keiro-dsl/runtime-semantics/2"+        Right _ -> expectationFailure "expected a runtime-profile mismatch"++    it "reports every formerly silent fold-resolution failure and propagates it" $ do+      baseService <- checkedServiceOf "test/fixtures/id-domain-migration-v3.keiro"+      recursiveMapped <- specOf "test/fixtures/mapped-recursive.keiro"+      brokenNominal <- specOf "test/fixtures/nominal-missing-facts.keiro"+      missingInitial <- specOf "test/fixtures/mapped-missing-initial.keiro"+      let contract = checkedLanguageContract baseService+          baseSpec = checkedSpec baseService+          baseAggregate = onlyAggregate baseSpec+          withAggregate transform =+            specWithNodes+              [ NAggregate (transform aggregate)+              | NAggregate aggregate <- baseSpec.nodes+              ]+              baseSpec+          replaceFirstTransition transform aggregate =+            aggregateWithTransitions+              (case aggregate.transitions of transition : rest -> transform transition : rest; [] -> [])+              aggregate+          guardSpec = withAggregate (replaceFirstTransition (transitionWithGuard (Just (EAtom (AName "missingGuardRoot")))))+          outputSpec = withAggregate (replaceFirstTransition (transitionWithEmits ["MissingEvent"]))+          typeGraphSpec = specWithMapped recursiveMapped.mapped baseSpec+          nominalSpec = specWithNominalScalars brokenNominal.nominalScalars baseSpec+          cases =+            [ (checkedServiceForContract contract typeGraphSpec, baseAggregate, \case FoldTypeGraphResolutionFailed {} -> True; _ -> False),+              (checkedServiceForContract contract nominalSpec, baseAggregate, \case FoldNominalResolutionFailed {} -> True; _ -> False),+              (checkedServiceForContract contract missingInitial, onlyAggregate missingInitial, \case FoldRegisterInitialResolutionFailed {} -> True; _ -> False),+              (checkedServiceForContract contract guardSpec, onlyAggregate guardSpec, \case FoldGuardResolutionFailed {} -> True; _ -> False),+              (checkedServiceForContract contract outputSpec, onlyAggregate outputSpec, \case FoldEventOutputResolutionFailed {} -> True; _ -> False)+            ]+      forM_ cases $ \(service, aggregate, matches) -> do+        CheckedFold.aggregateFoldSurfaceForService service aggregate+          `shouldSatisfy` either matches (const False)+        CheckedFold.aggregateFoldFingerprintForService service aggregate+          `shouldSatisfy` either matches (const False)+      let brokenService = checkedServiceForContract contract guardSpec+      CheckedDiff.diffServices brokenService baseService `shouldSatisfy` isLeft+      ReplayImpact.replayImpactServices brokenService baseService `shouldSatisfy` isLeft+      planTestServiceScaffold (defaultContext (guardSpec.context)) brokenService+        `shouldSatisfy` \case+          Left refusals -> any (\case FoldSurfaceRefusal {} -> True; _ -> False) refusals+          Right _ -> False++    it "pins representative diff and replay-impact rendering" $ do+      old <- parsedSourceOf "test/fixtures/reservation.keiro"+      new <- parsedSourceOf "test/fixtures/reservation-guard-tightened.keiro"+      let changes = diffSources old new+          impact = resolvedFold (ReplayImpact.replayImpactServices (checkedSource old) (checkedSource new))+          actual =+            T.intercalate+              "\n"+              ( "diff:"+                  : map renderFinding changes+                    <> ["replay:", ReplayImpact.renderReplayImpact impact]+              )+      assertMatchesGolden "test/fixtures/fold-identity-diff-replay.golden" actual++    it "pins unrelated public 64-bit identities outside the fold digest" $ do+      readModelSpec <- specOf "test/fixtures/readmodel.keiro"+      wireSpec <- specOf "test/fixtures/consumer-types.keiro"+      behaviorSpec <- specOf "test/fixtures/behavior-complete.keiro"+      readModel <- case [value | NReadModel value <- (.nodes) readModelSpec] of+        value : _ -> pure value+        [] -> expectationFailure "missing read-model fixture" >> fail "unreachable"+      graph <- shouldResolveTypeGraph wireSpec+      behaviorKey <- case Behavior.deriveBehaviorRequirements behaviorSpec of+        Right (requirement : _) -> pure (Behavior.unBehaviorKey ((.key) requirement))+        result -> expectationFailure ("missing behavior requirement: " <> show result) >> fail "unreachable"+      deriveShapeHash readModel `shouldBe` "fnv1a:3717f6d9e3c44bd6"+      wireFingerprint graph "ArtifactInfo" `shouldBe` "2bd99b3e57bcde9b"+      behaviorKey `shouldBe` "behavior-v1-0128e858fee6f2b3"++  describe "source language version" $ do+    let legacy = "context hospital-capacity\n"+        declared = "# leading comment\n\nlanguage keiro-dsl 1\ncontext hospital-capacity\n"+        code source = case parseSource "source.keiro" source of+          Left (SourceLanguageFailure diagnostic) -> Just ((.errorCode) diagnostic)+          _ -> Nothing+        parseRight name source = case parseSource name source of+          Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+          Right value -> pure value+        declaredVersionOf DeclaredLanguage {declaredLanguageVersion = version} = Just version+        declaredVersionOf LegacyUnversioned = Nothing+        orderedSubstrings needles haystack = go (map T.pack needles) (T.pack haystack)+          where+            go [] _ = True+            go (needle : rest) remaining =+              let (_, suffix) = T.breakOn needle remaining+               in not (T.null suffix) && go rest (T.drop (T.length needle) suffix)++    it "selects declared v1 after comments while preserving semantic equality" $ do+      legacySource <- parseRight "legacy.keiro" legacy+      declaredSource <- parseRight "declared.keiro" declared+      (.spec) legacySource `shouldBe` (.spec) declaredSource+      (.sourceLanguage) legacySource `shouldBe` LegacyUnversioned+      declaredVersionOf ((.sourceLanguage) declaredSource) `shouldBe` languageVersion 1+      effectiveLanguageVersion ((.sourceLanguage) legacySource)+        `shouldBe` effectiveLanguageVersion ((.sourceLanguage) declaredSource)++    it "threads paired released versions through one checked semantic boundary" $ do+      let body = T.unlines ["context semantic-pair", "aggregate Counter", "  regs", "  states Open"]+          v1Text = "language keiro-dsl 1\n" <> body+          v2Text = "language keiro-dsl 2\n" <> body+      v1Source <- parseRight "reservation-v1.keiro" v1Text+      v2Source <- parseRight "reservation-v2.keiro" v2Text+      let v1Service = checkedSource v1Source+          v2Service = checkedSource v2Source+          v1Spec = checkedSpec v1Service+          v2Spec = checkedSpec v2Service+          ctx = defaultContext (v1Spec.context)+          aggregates spec = [aggregate | NAggregate aggregate <- (.nodes) spec]+      v1Spec `shouldBe` v2Spec+      Just ((.contractLanguageVersion) (checkedLanguageContract v1Service)) `shouldBe` languageVersion 1+      Just ((.contractLanguageVersion) (checkedLanguageContract v2Service)) `shouldBe` languageVersion 2+      effectiveRuntimeSemantics (checkedLanguageContract v1Service)+        `shouldBe` effectiveRuntimeSemantics (checkedLanguageContract v2Service)+      validateService v1Service `shouldBe` validateService v2Service+      scaffoldServiceModules ctx v1Service `shouldBe` scaffoldServiceModules ctx v2Service+      case (aggregates v1Spec, aggregates v2Spec) of+        ([v1Aggregate], [v2Aggregate]) -> do+          aggregateFoldSurfaceForService v1Service v1Aggregate+            `shouldBe` aggregateFoldSurfaceForService v2Service v2Aggregate+          aggregateFoldFingerprintForService v1Service v1Aggregate+            `shouldBe` aggregateFoldFingerprintForService v2Service v2Aggregate+        other -> expectationFailure ("expected one aggregate per paired source, got " <> show (fmap length other))+      diffServices v1Service v2Service `shouldBe` []+      resolvedFold (ReplayImpact.replayImpactServices v1Service v2Service) `shouldBe` ReplayNeutral++    it "retains one effective contract for same-version workspaces and refuses mixed versions" $ do+      let manifest = "service semantic-workspace\nspec domain/a.keiro\nspec domain/b.keiro\n"+          v1Body = "language keiro-dsl 1\ncontext semantic-workspace\n"+          v2Body = "language keiro-dsl 2\ncontext semantic-workspace\n"+          sourceWith b =+            memoryContentSource+              ( Map.fromList+                  [ ("service.keiro-workspace", manifest),+                    ("domain/a.keiro", b),+                    ("domain/b.keiro", b)+                  ]+              )+          mixedSource =+            memoryContentSource+              ( Map.fromList+                  [ ("service.keiro-workspace", manifest),+                    ("domain/a.keiro", v1Body),+                    ("domain/b.keiro", v2Body)+                  ]+              )+      sameVersion <- loadWorkspace (sourceWith v2Body) "service.keiro-workspace"+      case sameVersion of+        Right workspace -> do+          Just ((.contractLanguageVersion) (checkedLanguageContract (checkedWorkspace workspace))) `shouldBe` languageVersion 2+          validateService (checkedWorkspace workspace) `shouldBe` []+        Left failure -> expectationFailure (show failure)+      mixed <- loadWorkspace mixedSource "service.keiro-workspace"+      case mixed of+        Left (WorkspaceRefused diagnostics) ->+          map (.code) (NE.toList diagnostics) `shouldContain` [WorkspaceLanguageVersionMismatch]+        other -> expectationFailure ("expected a mixed-version refusal, got " <> show other)++    it "refuses a source/service contract mismatch before creating the output directory" $ do+      v1Version <- maybe (expectationFailure "version 1 missing" >> fail "unreachable") pure (languageVersion 1)+      parsed <- parseRight "semantic-v2.keiro" "language keiro-dsl 2\ncontext semantic-refusal\n"+      let service = checkedSource parsed+          ctx = defaultContext "semantic-refusal"+      modules <- case planTestServiceScaffold ctx service of+        Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+        Right planned -> pure planned+      withTempDirectory "keiro-dsl-semantic-refusal" $ \root -> do+        let out = root </> "not-created"+        result <- executeServiceScaffold out False "semantic-v2.keiro" (DeclaredLanguage v1Version noLoc) ctx service modules+        result `shouldBe` Left [SemanticContractMismatch "source provenance and checked service selected different effective language contracts"]+        doesDirectoryExist out `shouldReturn` False++    it "retains explicit declarations in source rendering and leaves legacy unversioned" $ do+      legacySource <- parseRight "legacy.keiro" legacy+      declaredSource <- parseRight "declared.keiro" declared+      renderSource legacySource `shouldBe` "context hospital-capacity\n"+      renderSource declaredSource `shouldBe` "language keiro-dsl 1\ncontext hospital-capacity\n"+      parseSpec "declared.keiro" declared `shouldBe` Right ((.spec) declaredSource)++    it "classifies invalid, unsupported, duplicate, and misplaced preambles" $ do+      code "language keiro-dsl 0\ncontext hospital-capacity\n" `shouldBe` Just InvalidLanguageVersion+      code "language keiro-dsl nope\ncontext hospital-capacity\n" `shouldBe` Just InvalidLanguageVersion+      code "language keiro-dsl -1\ncontext hospital-capacity\n" `shouldBe` Just InvalidLanguageVersion+      code "language keiro-dsl 999999\ncontext hospital-capacity\n" `shouldBe` Just UnsupportedLanguageVersion+      code "language keiro-dsl 1\nlanguage keiro-dsl 1\ncontext hospital-capacity\n" `shouldBe` Just DuplicateLanguagePreamble+      code "context hospital-capacity\nlanguage keiro-dsl 1\n" `shouldBe` Just MisplacedLanguagePreamble++    it "treats language and successor spellings as data in nested grammar positions" $ do+      forM_ ["language-identifier-v1.keiro", "language-identifier-v2.keiro"] $ \fixture -> do+        source <- readTestText ("test/fixtures/" <> fixture)+        parsed <- parseRight fixture source+        validateSpec ((.spec) parsed) `shouldBe` []+      v1 <- readTestText "test/fixtures/language-identifier-v1.keiro"+      let manifest = "service language-collisions\nspec domain/collisions.keiro\n"+          workspaceSource = memoryContentSource (Map.fromList [("service.keiro-workspace", manifest), ("domain/collisions.keiro", v1)])+      loaded <- loadWorkspace workspaceSource "service.keiro-workspace"+      loaded `shouldSatisfy` isRight++    it "keeps duplicate and misplaced preamble diagnostics on their grammar lines" $ do+      let sourceFailureAt expectedCode expectedLine source =+            case parseSource "located.keiro" source of+              Left (SourceLanguageFailure diagnostic) -> do+                (.errorCode) diagnostic `shouldBe` expectedCode+                unLoc ((.loc) diagnostic) `shouldBe` expectedLine+              other -> expectationFailure ("expected located source-language failure, got " <> show other)+      sourceFailureAt DuplicateLanguagePreamble 2 "language keiro-dsl 1\nlanguage keiro-dsl 1\ncontext located\n"+      sourceFailureAt MisplacedLanguagePreamble 3 "context located\nid language prefix=lang\nlanguage keiro-dsl 1\n"++    it "rejects a future version before parsing an invalid v1 body" $+      case parseSource "unregistered.keiro" "language keiro-dsl 999999\nthis is not a v2 body\n" of+        Left failure@(SourceLanguageFailure diagnostic) -> do+          (.errorCode) diagnostic `shouldBe` UnsupportedLanguageVersion+          renderParseFailure failure `shouldSatisfy` T.isInfixOf "supported versions: 1, 2, 3, 4, 5"+          renderParseFailure failure `shouldNotSatisfy` T.isInfixOf "expecting `context`"+        other -> expectationFailure ("expected source-language failure, got " <> show other)++    it "accepts and canonically round-trips nominal declarations only in v2" $ do+      let nominalSource =+            T.unlines+              [ "language keiro-dsl 2",+                "context orders",+                "id OrderId prefix=ord using {",+                "  haskell package=orders-domain module=Orders.Id type=OrderId",+                "  binding = \"Orders.KeiroBindings.orderIdBinding\"",+                "  binding-version = \"1\"",+                "  canonical-type = \"orders.OrderId.v1\"",+                "  fixtures = \"Orders.KeiroBindings.orderIdFixtures\"",+                "}",+                "enum OrderStatus { Draft=draft Submitted=submitted } using {",+                "  haskell package=orders-domain module=Orders.Order type=OrderStatus",+                "  binding = \"Orders.KeiroBindings.orderStatusBinding\"",+                "  binding-version = \"1\"",+                "  canonical-type = \"orders.OrderStatus.v1\"",+                "  fixtures = \"Orders.KeiroBindings.orderStatusFixtures\"",+                "}",+                "mapped nominal AccountNumber : Text {",+                "  haskell package=orders-domain module=Orders.Account type=AccountNumber",+                "  binding = \"Orders.KeiroBindings.accountNumberBinding\"",+                "  binding-version = \"1\"",+                "  canonical-type = \"orders.AccountNumber.v1\"",+                "  fixtures = \"Orders.KeiroBindings.accountNumberFixtures\"",+                "  initial = \"Orders.KeiroBindings.initialAccountNumber\"",+                "}"+              ]+      parsed <- parseRight "nominal.keiro" nominalSource+      length ((.ids) ((.spec) parsed)) `shouldBe` 1+      length ((.enums) ((.spec) parsed)) `shouldBe` 1+      length ((.nominalScalars) ((.spec) parsed)) `shouldBe` 1+      parseSource "nominal-round-trip.keiro" (renderSource parsed) `shouldBe` Right parsed++    it "reports successor nominal syntax as one language-version diagnostic under v1 and legacy" $ do+      let body = "context orders\nmapped nominal AccountNumber : Text {}\n"+      code ("language keiro-dsl 1\n" <> body) `shouldBe` Just LanguageFeatureRequiresVersion+      code body `shouldBe` Just LanguageFeatureRequiresVersion++    it "parses and canonically round-trips field aliases only in language 4" $ do+      let v4Source =+            T.unlines+              [ "language keiro-dsl 4",+                "context aliases",+                "aggregate Order",+                "  regs",+                "  states Open",+                "  command Change { type haskell payloadType as \"type\":Text haskell as }",+                "contract publicOrder {",+                "  schemaVersion 1",+                "  discriminator kind",+                "  topic changes \"orders.v1\"",+                "  event Changed on changes {",+                "    region haskell serviceRegion as \"region_code\": text",+                "  }",+                "}"+              ]+          v3Source = T.replace "language keiro-dsl 4" "language keiro-dsl 3" v4Source+      parsed <- parseRight "field-aliases.keiro" v4Source+      parseSource "field-aliases-round-trip.keiro" (renderSource parsed) `shouldBe` Right parsed+      case (.nodes) ((.spec) parsed) of+        [NAggregate aggregate, NContract contract] -> do+          case (.fields) =<< (.commands) aggregate of+            aliased : haskellField : asField : _ -> do+              ((.name) aliased, (.selector) aliased, (.wireKey) aliased)+                `shouldBe` ("type", Just "payloadType", Just "type")+              map (.name) [haskellField, asField] `shouldBe` ["haskell", "as"]+            fields -> expectationFailure ("unexpected aggregate alias fields: " <> show fields)+          case (.fields) =<< (.events) contract of+            [field] ->+              ((.name) field, (.selector) field, (.wireKey) field, (.loc) field)+                `shouldBe` ("region", Just "serviceRegion", Just "region_code", Loc 12)+            fields -> expectationFailure ("unexpected contract alias fields: " <> show fields)+        nodes -> expectationFailure ("unexpected alias nodes: " <> show nodes)+      code v3Source `shouldBe` Just LanguageFeatureRequiresVersion++    it "attributes every successor feature gate to its owning grammar production" $ do+      let featureFailureAt expectedLine source =+            case parseSource "feature.keiro" source of+              Left (SourceLanguageFailure diagnostic) -> do+                (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion+                unLoc ((.loc) diagnostic) `shouldBe` expectedLine+              other -> expectationFailure ("expected a located feature gate, got " <> show other)+          aggregateWith clause =+            T.unlines+              [ "language keiro-dsl 1",+                "context feature-gates",+                "aggregate Account",+                "  regs",+                "    balance Text = \"0\"",+                "  states Open",+                "  command Adjust { amount:Text }",+                "  event Adjusted = fields(Adjust)",+                "  Open -- Adjust --> " <> clause <> " ; emit Adjusted ; goto Open"+              ]+      featureFailureAt 3 (T.unlines ["language keiro-dsl 1", "context feature-gates", "id AccountId prefix=acct using {"])+      featureFailureAt 3 (T.unlines ["language keiro-dsl 1", "context feature-gates", "mapped nominal AccountNumber : Text {}"])+      featureFailureAt 5 (T.unlines ["language keiro-dsl 1", "context feature-gates", "aggregate Account", "  regs", "    balance Integer = 0", "  states Open"])+      featureFailureAt 9 (aggregateWith "guard reg.balance == cmd.amount")+      featureFailureAt 9 (aggregateWith "implementation hole")++    it "reports a declaration-only rewrite without semantic, generated, fold, or replay impact" $ do+      fixture <- readTestText "test/fixtures/language-v1.keiro"+      let legacyFixture = T.unlines (drop 1 (T.lines fixture))+      legacySource <- parseRight "legacy.keiro" legacyFixture+      declaredSource <- parseRight "declared.keiro" fixture+      let oldSpec = (.spec) legacySource+          newSpec = (.spec) declaredSource+          changes = diffSources legacySource declaredSource+          vectors = [kind.vector | change <- changes, let kind = workspaceChangeKind change]+      map changeCode changes `shouldBe` [SourceLanguageDeclarationChanged]+      legacyDiffSpecs oldSpec newSpec `shouldBe` []+      vectors `shouldSatisfy` all (\compatibility -> all ((== VCompatible) . (`verdictFor` compatibility)) [minBound .. maxBound])+      case changes of+        [change] ->+          remediationFor ((workspaceChangeKind change).context) SourceLanguageDeclarationChanged+            `shouldBe` (RemedyNoSemanticAction :| [])+        _ -> expectationFailure "expected one source-language change"+      let legacyGeneratedSurface spec =+            [ ((.path) scaffoldModule, (.text) scaffoldModule, (.kind) scaffoldModule)+            | scaffoldModule <- scaffoldModules (defaultContext (spec.context)) spec+            ]+          legacyFoldFingerprint spec aggregate = aggregateFoldFingerprintForService (legacyCheckedService spec) aggregate+      legacyGeneratedSurface oldSpec `shouldBe` legacyGeneratedSurface newSpec+      [legacyFoldFingerprint oldSpec aggregate | NAggregate aggregate <- (.nodes) oldSpec]+        `shouldBe` [legacyFoldFingerprint newSpec aggregate | NAggregate aggregate <- (.nodes) newSpec]+      legacyReplayImpactSpecs oldSpec newSpec `shouldBe` ReplayNeutral++    it "exposes published support in source and workspace JSON inspection" $ do+      (sourceCode, sourceOut, sourceErr) <- runKeiroDsl ["inspect", "test/fixtures/reservation.keiro", "--format=json"]+      sourceCode `shouldBe` ExitSuccess+      sourceErr `shouldBe` ""+      sourceOut `shouldContain` "\"schema\":\"keiro-dsl/source-inspection/1\""+      sourceOut `shouldContain` "\"kind\":\"source\""+      sourceOut `shouldContain` "\"sourceForm\":\"declared\""+      sourceOut `shouldContain` "\"declaredLanguageVersion\":4"+      sourceOut `shouldContain` "\"effectiveLanguageVersion\":4"+      sourceOut `shouldContain` "\"effectiveSemanticContract\":{"+      sourceOut `shouldContain` "\"runtimeSemantics\":\"keiro-dsl/runtime-semantics/3\""+      sourceOut `shouldContain` "\"languageSupport\":\"compatibility-only\""+      (workspaceCode, workspaceOut, workspaceErr) <- runKeiroDsl ["inspect", canonicalWorkspacePath, "--format=json"]+      workspaceCode `shouldBe` ExitSuccess+      workspaceErr `shouldBe` ""+      workspaceOut `shouldContain` "\"kind\":\"workspace\""+      workspaceOut `shouldContain` "\"service\":\"demo-project\""+      workspaceOut `shouldContain` "\"effectiveSemanticContract\":{"+      workspaceOut `shouldContain` "\"languageSupport\":\"compatibility-only\""+      workspaceOut `shouldSatisfy` orderedSubstrings ["domain/project-artifact.keiro", "domain/project.keiro", "domain/shared.keiro"]+      (stableCode, stableOut, stableErr) <- runKeiroDsl ["inspect", "test/fixtures/workflow-evolution.keiro", "--format=json"]+      stableCode `shouldBe` ExitSuccess+      stableErr `shouldBe` ""+      stableOut `shouldContain` "\"declaredLanguageVersion\":5"+      stableOut `shouldContain` "\"effectiveLanguageVersion\":5"+      stableOut `shouldContain` "\"languageSupport\":\"stable\""++    it "keeps only the named source-version and candidate fixtures outside published Language 4" $ do+      fixtureTree <- treeSnapshot "test/fixtures"+      let outsideStableV4 =+            sort+              [ path+              | (path, contents) <- fixtureTree,+                takeExtension path == ".keiro",+                "language keiro-dsl 4" `notElem` T.lines contents+              ]+      outsideStableV4+        `shouldBe` sort+          [ "aggregate-collection-expressions-v2-rejects.keiro",+            "aggregate-scalar-expressions-v1-rejects.keiro",+            "catalog-readmodel-backing-required.keiro",+            "catalog-readmodel-backing-unobserved.keiro",+            "catalog-readmodel-physical-override.keiro",+            "catalog-readmodel-reorder-a.keiro",+            "catalog-readmodel-reorder-b.keiro",+            "contract-v1-compat.keiro",+            "contract-declared-id-language5.keiro",+            "contract-declared-id-literal-to-declared.keiro",+            "contract-declared-id-prefix-change.keiro",+            "contract-declared-id.keiro",+            "declarative-router/unbounded.keiro",+            "declarative-router/valid.keiro",+            "direct-optional-id.keiro",+            "domain-command-outcomes.keiro",+            "hospital-surge-reactions.keiro",+            "id-domain-migration-v3.keiro",+            "intake-delegated.keiro",+            "language-duplicate.keiro",+            "language-identifier-v1.keiro",+            "language-identifier-v2.keiro",+            "language-legacy.keiro",+            "language-malformed.keiro",+            "language-misplaced.keiro",+            "language-v1.keiro",+            "language-zero.keiro",+            "mapped-keyed-map-enum-key.keiro",+            "mapped-keyed-map-language5.keiro",+            "mapped-nominal-leaf-default.keiro",+            "mapped-nominal-leaf-enum.keiro",+            "mapped-nominal-leaf-enum-language.keiro",+            "mapped-nominal-leaf-language.keiro",+            "mapped-nominal-leaf.keiro",+            "mapped-nominal-query-only-enum.keiro",+            "mapped-nominal-query-only-language.keiro",+            "mapped-nominal-query-only.keiro",+            "mapped-nominal-queue-only-enum.keiro",+            "mapped-nominal-queue-only-language.keiro",+            "mapped-nominal-queue-only.keiro",+            "mapped-readmodel-workspace/readmodel.keiro",+            "mapped-readmodel-workspace/types.keiro",+            "mapped-readmodel.keiro",+            "mapped-workqueue.keiro",+            "nested-nominal-guard-mismatched-id.keiro",+            "nested-nominal-guard-optional-path.keiro",+            "nested-nominal-guard-ordering.keiro",+            "nominal-v1.keiro",+            "outcome-identifier-legacy.keiro",+            "outcome-identifier-v5.keiro",+            "projection-catalog-unrelated.keiro",+            "projection-catalog.keiro",+            "projection-owner-multi-query.keiro",+            "structural-nominal-leaves-enum-spelling.keiro",+            "structural-nominal-leaves-binding-change.keiro",+            "structural-nominal-leaves-keyed-map-key-change.keiro",+            "structural-nominal-leaves-opaque-to-nominal.keiro",+            "structural-nominal-leaves-prefix-change.keiro",+            "structural-nominal-leaves-text-to-nominal.keiro",+            "structural-nominal-leaves.keiro",+            "process-reactions-accepted-requires-event.keiro",+            "process-reactions-accepted-unverified.keiro",+            "process-reactions-badmapping.keiro",+            "process-reactions-cancel-unknown.keiro",+            "process-reactions-diff.keiro",+            "process-reactions-duplicate-input-declaration.keiro",+            "process-reactions-duplicate-on.keiro",+            "process-reactions-duplicate-timer.keiro",+            "process-reactions-fanout-changed.keiro",+            "process-reactions-guard-not-boolean.keiro",+            "process-reactions-input-unhandled.keiro",+            "process-reactions-language5.keiro",+            "process-reactions-minimal.keiro",+            "process-reactions-otherwise-missing.keiro",+            "process-reactions-otherwise-unreachable.keiro",+            "process-reactions-payload-incomplete.keiro",+            "process-reactions-reordered-unversioned.keiro",+            "process-reactions-reordered.keiro",+            "process-reactions-schedule-unknown.keiro",+            "process-reactions-silent-missing.keiro",+            "process-reactions-state-access.keiro",+            "process-reactions-timer-policy-missing.keiro",+            "process-reactions-timer-policy-unused.keiro",+            "process-reactions-timer-prefix-collision.keiro",+            "process-reactions-unknown-input.keiro",+            "process-reactions.keiro",+            "process-state-authority.keiro",+            "process-timers-identity-changed.keiro",+            "process-timers-payload-changed.keiro",+            "process-timers.keiro",+            "transition-family-additive.keiro",+            "transition-family-ambiguous-new.keiro",+            "transition-family-ambiguous-old.keiro",+            "transition-family-no-emit-tightened.keiro",+            "transition-family-outcome-new.keiro",+            "transition-family-outcome-old.keiro",+            "transition-family.keiro",+            "workflow-evolution.keiro",+            "workqueue-fifo-heads.keiro",+            "workspace-nominals/domain/project-artifact.keiro",+            "workspace-nominals/domain/project.keiro",+            "workspace-nominals/domain/shared.keiro"+          ]++    it "checks v1 and inspects legacy explicitly" $ do+      (v1Code, v1Out, v1Err) <- runKeiroDsl ["check", "test/fixtures/language-v1.keiro"]+      v1Code `shouldBe` ExitSuccess+      v1Out `shouldBe` "OK\n"+      v1Err `shouldContain` "language contract: effective keiro-dsl 1 (declared, compatibility-only, runtime semantics keiro-dsl/runtime-semantics/1)"+      (legacyCode, legacyOut, legacyErr) <- runKeiroDsl ["inspect", "test/fixtures/language-legacy.keiro", "--format=json"]+      legacyCode `shouldBe` ExitSuccess+      legacyErr `shouldBe` ""+      legacyOut `shouldContain` "\"sourceForm\":\"legacy-unversioned\""+      legacyOut `shouldContain` "\"declaredLanguageVersion\":null"+      legacyOut `shouldContain` "\"effectiveLanguageVersion\":1"+      legacyOut `shouldContain` "\"languageSupport\":\"compatibility-only\""++    it "checks and scaffolds contextual language identifiers through the CLI" $ do+      forM_ ["language-identifier-v1.keiro", "language-identifier-v2.keiro"] $ \fixture -> do+        let sourcePath = "test/fixtures/" <> fixture+        (checkCode, checkOut, checkErr) <- runKeiroDsl ["check", sourcePath]+        checkCode `shouldBe` ExitSuccess+        checkOut `shouldBe` "OK\n"+        checkErr `shouldContain` "language contract: effective keiro-dsl"+        withTempDirectory ("keiro-dsl-" <> fixture) $ \out -> do+          (scaffoldCode, _, scaffoldErr) <- runKeiroDsl ["scaffold", sourcePath, "--out", out]+          scaffoldCode `shouldBe` ExitSuccess+          scaffoldErr `shouldContain` "language contract: effective keiro-dsl"+          scaffoldErr `shouldContain` "firewall: OK"++    it "notices only the working-tree contract during diff" $+      withTempDirectory "keiro-dsl-language-diff" $ \repository -> do+        source <- readTestText "test/fixtures/language-v1.keiro"+        TIO.writeFile (repository </> "language.keiro") source+        let git arguments = readProcessWithExitCode "git" ("-C" : repository : arguments) ""+        forM_+          [ ["init", "--quiet"],+            ["add", "language.keiro"],+            ["-c", "user.name=keiro-dsl-test", "-c", "user.email=keiro-dsl-test@example.invalid", "commit", "--quiet", "-m", "test: capture language contract baseline"]+          ]+          $ \arguments -> do+            (gitCode, gitOut, gitErr) <- git arguments+            unless (gitCode == ExitSuccess) (expectationFailure (gitOut <> gitErr))+        (diffCode, _, diffErr) <- withCurrentDirectory repository (runKeiroDsl ["diff", "language.keiro", "--since", "HEAD"])+        diffCode `shouldBe` ExitSuccess+        T.count "language contract:" (T.pack diffErr) `shouldBe` 1+        diffErr `shouldContain` "language contract: effective keiro-dsl 1 (declared, compatibility-only, runtime semantics keiro-dsl/runtime-semantics/1)"++    it "preserves a workspace member's source-selection code beneath outer attribution" $ do+      let manifest = "service demo\nspec domain/future.keiro\n"+          futureSource = "language keiro-dsl 999999\nthis body must not parse\n"+          source = memoryContentSource (Map.fromList [("service.keiro-workspace", manifest), ("domain/future.keiro", futureSource)])+      loaded <- loadWorkspace source "service.keiro-workspace"+      case loaded of+        Left (WorkspaceRefused (diagnostic :| [])) -> do+          diagnostic.code `shouldBe` WorkspaceMemberParseFailed+          (.errorCode) <$> (.sourceLanguageCause) diagnostic+            `shouldBe` Just UnsupportedLanguageVersion+          renderWorkspaceDiagnostic "service.keiro-workspace" diagnostic+            `shouldSatisfy` T.isInfixOf "UnsupportedLanguageVersion"+        other -> expectationFailure ("expected one attributed source-language refusal, got " <> show other)++    it "attributes a workspace provenance-only diff to the changed member" $ do+      workspace <- shouldComposeWorkspace canonicalWorkspacePath+      case (.members) workspace of+        firstMember : remaining -> do+          let changedMember =+                WorkspaceMember+                  { path = firstMember.path,+                    spec = firstMember.spec,+                    sourceLanguage = LegacyUnversioned,+                    sourceIndex = firstMember.sourceIndex,+                    lineBase = firstMember.lineBase,+                    lineCount = firstMember.lineCount+                  }+              changedWorkspace = workspaceWithMembers (changedMember : remaining) workspace+              changes = diffWorkspaces workspace changedWorkspace+          map (changeCode . (.change)) changes `shouldBe` [SourceLanguageDeclarationChanged]+          map (fmap (.file) . (.declarationSite)) changes `shouldBe` [Just ((.path) firstMember)]+          map (.change) changes `shouldSatisfy` all (not . gatedBreaking (gateWith [minBound .. maxBound]))+        _ -> expectationFailure "canonical workspace had no member"++  describe "typed-domain-outcomes" $ do+    it "parses, validates, and canonically round-trips the complete language-5 fixture" $ do+      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"+      parsed <- case parseSource "domain-command-outcomes.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      validateService (checkedSource parsed) `shouldBe` []+      parseSource "domain-command-outcomes-rendered.keiro" (renderSource parsed) `shouldBe` Right parsed+      let outcomeKind :: TransitionOutcome -> T.Text+          outcomeKind outcome = case outcome of+            OutcomeAccepted {} -> "accepted"+            OutcomeRejected {} -> "rejected"+            OutcomeNoOp {} -> "no-op"+      case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) parsed)] of+        [aggregate] -> do+          fmap (\types -> ((.rejectionType) types, (.noOpType) types)) ((.domainOutcomeTypes) aggregate)+            `shouldBe` Just ("ReservationRejection", "ReservationNoOp")+          map (fmap outcomeKind . (.outcome)) ((.transitions) aggregate)+            `shouldBe` map Just ["accepted", "rejected", "no-op"]+        aggregates -> expectationFailure ("unexpected outcome aggregates: " <> show aggregates)++    it "gates the syntax to Language 5" $ do+      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"+      case parseSource "domain-command-outcomes-v4.keiro" (T.replace "language keiro-dsl 5" "language keiro-dsl 4" source) of+        Left (SourceLanguageFailure diagnostic) -> (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion+        other -> expectationFailure ("expected language feature refusal, got " <> show other)++    it "generates one direct exact-edge classifier arm per silent outcome" $ do+      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"+      parsed <- case parseSource "domain-command-outcomes.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      aggregate <- case [value | NAggregate value <- (.nodes) ((.spec) parsed)] of+        [value] -> pure value+        values -> expectationFailure ("unexpected outcome aggregates: " <> show values) >> fail "unreachable"+      let scaffoldContext = defaultContext (parsed.spec.context)+          modules = scaffoldAggregateForService scaffoldContext (checkedSource parsed) aggregate+          modulesAgain = scaffoldAggregateForService scaffoldContext (checkedSource parsed) aggregate+          eventStream = case [(.text) value | value <- modules, "/EventStream.hs" `T.isSuffixOf` T.pack ((.path) value)] of+            [value] -> value+            values -> error ("unexpected outcome event-stream modules: " <> show values)+          behaviorContract = case [(.text) value | value <- modules, "/BehaviorContract.hs" `T.isSuffixOf` T.pack ((.path) value)] of+            [value] -> value+            values -> error ("unexpected outcome behavior-contract modules: " <> show values)+      map (.text) modulesAgain `shouldBe` map (.text) modules+      firewallBreaches modules `shouldBe` []+      eventStream `shouldSatisfy` T.isInfixOf "reservationDomainCommandHandler"+      eventStream `shouldSatisfy` T.isInfixOf "case edgeSource of"+      eventStream `shouldSatisfy` T.isInfixOf "case edgeIndex of"+      T.count " -> SilentRejected" eventStream `shouldBe` 1+      T.count " -> SilentNoOp" eventStream `shouldBe` 1+      T.count "K.evalTerm" eventStream `shouldBe` 2+      eventStream `shouldSatisfy` T.isInfixOf "0 -> SilentRejected"+      eventStream `shouldSatisfy` T.isInfixOf "1 -> SilentNoOp"+      forM_ ["Data.Map", "lookup", "find", "edgesOut", "Keiro.Command.Domain"] $ \forbidden ->+        eventStream `shouldSatisfy` (not . T.isInfixOf forbidden)+      behaviorContract `shouldSatisfy` T.isInfixOf "RejectedWith ReservationRejection"+      behaviorContract `shouldSatisfy` T.isInfixOf "NoOpWith ReservationNoOp"+      behaviorContract `shouldSatisfy` T.isInfixOf "runSilentDecision"+      behaviorContract `shouldSatisfy` T.isInfixOf "reservationDomainCommandHandler"++    it "reports complete, typed, and state-preserving outcome diagnostics" $ do+      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"+      let codes changed = do+            case parseSource "domain-outcome-mutation.keiro" changed of+              Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> pure []+              Right parsed -> pure (map (.code) (validateService (checkedSource parsed)))+          expectCode expected changed = codes changed >>= (`shouldContain` [expected])+      expectCode+        DomainOutcomeDeclarationDuplicate+        (T.replace "  domain-outcomes rejection=ReservationRejection no-op=ReservationNoOp\n" "  domain-outcomes rejection=ReservationRejection no-op=ReservationNoOp\n  domain-outcomes rejection=ReservationRejection no-op=ReservationNoOp\n" source)+      expectCode+        DomainOutcomeDeclarationMissing+        (T.replace "  domain-outcomes rejection=ReservationRejection no-op=ReservationNoOp\n" "" source)+      expectCode+        DomainOutcomeClauseMissing+        (T.replace "    outcome accepted\n" "" source)+      expectCode+        DomainOutcomeClauseDuplicate+        (T.replace "    outcome accepted\n" "    outcome accepted\n    outcome accepted\n" source)+      expectCode+        DomainOutcomeTypeUnresolved+        (T.replace "rejection=ReservationRejection" "rejection=MissingRejection" source)+      expectCode+        DomainOutcomeReasonTypeMismatch+        (T.replace "ReservationRejection.AlreadyCancelled" "ReservationNoOp.DuplicateRequest" source)+      expectCode+        DomainOutcomeAcceptedWithoutEvents+        (T.replace "    emit Cancelled\n" "" source)+      expectCode+        DomainOutcomeSilentEmits+        (T.replace "    outcome rejected ReservationRejection.AlreadyCancelled\n" "    outcome rejected ReservationRejection.AlreadyCancelled\n    emit Cancelled\n" source)+      expectCode+        DomainOutcomeSilentWrites+        (T.replace "    outcome no-op ReservationNoOp.DuplicateRequest\n" "    outcome no-op ReservationNoOp.DuplicateRequest\n    write lastRequestId := cmd.requestId\n" source)+      expectCode+        DomainOutcomeSilentStateChange+        (T.replace "    outcome no-op ReservationNoOp.DuplicateRequest\n    goto CancelledState\n" "    outcome no-op ReservationNoOp.DuplicateRequest\n    goto Eligible\n" source)+      expectCode+        DomainOutcomeReplayOnlyClause+        (T.replace "  CancelledState -- Cancel -->\n    guard cmd.requestId != reg.lastRequestId" "  replay-only CancelledState -- Cancel -->\n    guard cmd.requestId != reg.lastRequestId" source)++    it "changes behavior identity and semantic diff without moving fold or replay identity" $ do+      source <- readTestText "test/fixtures/domain-command-outcomes.keiro"+      let changedSource = T.replace "ReservationRejection.AlreadyCancelled" "ReservationRejection.CapacityUnavailable" source+      oldParsed <- case parseSource "domain-outcomes-old.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      newParsed <- case parseSource "domain-outcomes-new.keiro" changedSource of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      validateService (checkedSource newParsed) `shouldBe` []+      oldAggregate <- case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) oldParsed)] of+        [aggregate] -> pure aggregate+        aggregates -> expectationFailure ("unexpected old outcome aggregates: " <> show aggregates) >> fail "unreachable"+      newAggregate <- case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) newParsed)] of+        [aggregate] -> pure aggregate+        aggregates -> expectationFailure ("unexpected new outcome aggregates: " <> show aggregates) >> fail "unreachable"+      let changes = diffSources oldParsed newParsed+          oldBehavior = Behavior.deriveAggregateBehaviorRequirements ((.spec) oldParsed) oldAggregate+          newBehavior = Behavior.deriveAggregateBehaviorRequirements ((.spec) newParsed) newAggregate+          changeKind change = case change of+            Additive value -> value+            Advisory value -> value+            Breaking value -> value+      map ((.code) . changeKind) changes `shouldContain` [DomainTransitionOutcomeChanged]+      map ((.code) . changeKind) changes `shouldNotContain` [AggFoldSurfaceChanged]+      aggregateFoldFingerprintForService (checkedSource oldParsed) oldAggregate+        `shouldBe` aggregateFoldFingerprintForService (checkedSource newParsed) newAggregate+      oldBehavior `shouldNotBe` newBehavior+      ReplayImpact.replayImpactServices (checkedSource oldParsed) (checkedSource newParsed)+        `shouldBe` Right ReplayImpact.ReplayNeutral++  describe "outcome identifier compatibility" $ do+    it "parses outcome as an ordinary identifier under legacy and declared language 1" $ do+      source <- readTestText "test/fixtures/outcome-identifier-legacy.keiro"+      case parseSource "outcome-identifier-legacy.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right _ -> pure ()+      case parseSource "outcome-identifier-v1.keiro" ("language keiro-dsl 1\n" <> source) of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right _ -> pure ()++    it "parses outcome as an ordinary identifier under languages 2, 3, and 4" $ do+      source <- readTestText "test/fixtures/outcome-identifier.keiro"+      forM_ ["2", "3", "4"] $ \version ->+        case parseSource+          ("outcome-identifier-v" <> T.unpack version <> ".keiro")+          (T.replace "language keiro-dsl 4" ("language keiro-dsl " <> version) source) of+          Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+          Right parsed+            | version == "4" -> validateService (checkedSource parsed) `shouldBe` []+            | otherwise -> pure ()++    it "parses outcome as an enum constructor, state, and transition source" $ do+      source <- readTestText "test/fixtures/outcome-identifier-positions.keiro"+      case parseSource "outcome-identifier-positions.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right parsed -> validateService (checkedSource parsed) `shouldBe` []++    it "round-trips outcome identifiers through the canonical renderer" $ do+      source <- readTestText "test/fixtures/outcome-identifier.keiro"+      parsed <- case parseSource "outcome-identifier.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      parseSource "outcome-identifier-rendered.keiro" (renderSource parsed) `shouldBe` Right parsed++    it "keeps outcome usable as an identifier alongside language-5 outcome clauses" $ do+      source <- readTestText "test/fixtures/outcome-identifier-v5.keiro"+      case parseSource "outcome-identifier-v5.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right parsed -> validateService (checkedSource parsed) `shouldBe` []++  describe "language-5 projection catalogs" $ do+    it "rejects explicit physical coordinates on a catalog-bound read model" $ do+      errorCodesOf "test/fixtures/catalog-readmodel-physical-override.keiro"+        `shouldReturn` [CatalogReadModelPhysicalOverride]++    it "requires an observed backing target for multi-target read models" $ do+      errorCodesOf "test/fixtures/catalog-readmodel-backing-required.keiro"+        `shouldReturn` [CatalogReadModelBackingRequired]+      errorCodesOf "test/fixtures/catalog-readmodel-backing-unobserved.keiro"+        `shouldReturn` [CatalogReadModelBackingUnobserved]++    it "binds catalog read models by name and ignores observed-target order" $ do+      sourceA <- readTestText "test/fixtures/catalog-readmodel-reorder-a.keiro"+      sourceB <- readTestText "test/fixtures/catalog-readmodel-reorder-b.keiro"+      parsedA <- case parseSource "catalog-readmodel-reorder-a.keiro" sourceA of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      case parseSource "catalog-readmodel-reorder-a-rendered.keiro" (renderSource parsedA) of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right rendered -> (.spec) rendered `shouldBe` (.spec) parsedA+      serviceA <- checkedServiceFromText "catalog-readmodel-reorder-a.keiro" sourceA+      serviceB <- checkedServiceFromText "catalog-readmodel-reorder-b.keiro" sourceB+      validateService serviceA `shouldBe` []+      validateService serviceB `shouldBe` []+      let ctx = defaultContext ((checkedSpec serviceA).context)+          modulesA = scaffoldServiceModules ctx serviceA+          modulesB = scaffoldServiceModules ctx serviceB+          generatedBytes modules = sort [((.path) moduleValue, (.text) moduleValue) | moduleValue <- modules]+          tableA = generatedTextEndingIn "Generated/BindingDemo/LedgerView/ReadModelTable.hs" modulesA+      generatedBytes modulesA `shouldBe` generatedBytes modulesB+      tableA `shouldSatisfy` T.isInfixOf "qualifyTable \"billing\" \"ledger_entries\""+      map ((.code) . kindOfChange) (diffServices serviceA serviceB)+        `shouldNotContain` [CatalogQueryBindingChanged]++    it "emits grouped harness facts against the generated projection catalog" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      service <- checkedServiceFromText "projection-catalog.keiro" source+      let spec = checkedSpec service+          modules = scaffoldServiceModules (defaultContext (spec.context)) service+          auditHarness = generatedTextEndingIn "Generated/CatalogDemo/CatalogAudit/ReadModelHarness.hs" modules+          totalsHarness = generatedTextEndingIn "Generated/CatalogDemo/OrderTotalsLookup/ReadModelHarness.hs" modules+          shipmentHarness = generatedTextEndingIn "Generated/CatalogDemo/ShipmentLookup/ReadModelHarness.hs" modules+      auditHarness `shouldSatisfy` T.isInfixOf "import Generated.CatalogDemo.ProjectionCatalog qualified as ProjectionCatalog"+      auditHarness `shouldSatisfy` T.isInfixOf "ProjectionCatalog.projectionCatalogAsyncRegistrations"+      auditHarness `shouldSatisfy` T.isInfixOf "ProjectionCatalog.projectionCatalogQuerySupplies"+      auditHarness `shouldSatisfy` T.isInfixOf "catalog-demo-catalogAudit|1|fnv1a:9682af3ada04bf50|reporting"+      auditHarness `shouldSatisfy` T.isInfixOf "asyncRegistration:audit_writer"+      auditHarness `shouldSatisfy` T.isInfixOf "querySupply"+      auditHarness `shouldSatisfy` T.isInfixOf "projectionDelivery"+      auditHarness `shouldSatisfy` T.isInfixOf "(\"freshness\", \"Immediate\""+      auditHarness `shouldSatisfy` T.isInfixOf "(\"cursorAuthority\", \"DurableQueryCursor \\\"catalog-demo-audit\\\"\""+      auditHarness `shouldSatisfy` T.isInfixOf "catalog-demo-audit|catalog-demo-audit-v1"+      auditHarness `shouldNotSatisfy` T.isInfixOf "\"catalog-managed\", \"catalog-managed\""+      totalsHarness `shouldSatisfy` T.isInfixOf "order_summary_writer|reporting|order_totals"+      shipmentHarness `shouldSatisfy` T.isInfixOf "catalogRegistration"+      shipmentHarness `shouldNotSatisfy` T.isInfixOf "asyncRegistration:"++    it "parses, validates, and canonically round-trips the closed-world catalog graph" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      parsed <- case parseSource "projection-catalog.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      validateService (checkedSource parsed) `shouldBe` []+      case parseSource "projection-catalog-rendered.keiro" (renderSource parsed) of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right rendered -> (.spec) rendered `shouldBe` (.spec) parsed++      let spec = parsed.spec+          targets = [target | NProjectionTarget target <- (.nodes) spec]+          groups = [groupNode | NRebuildGroup groupNode <- (.nodes) spec]+          externalReads = [externalRead | NExternalRead externalRead <- (.nodes) spec]+          owners = [owner | NProjectionOwner owner <- (.nodes) spec]+      map (.name) targets `shouldBe` ["order_summary", "audit_log", "order_totals", "shipment_summary"]+      map (.name) groups `shouldBe` ["reporting", "shipping"]+      map (\externalRead -> ((.name) externalRead, (.version) externalRead, (.queryModel) externalRead)) externalReads+        `shouldBe` [("order_totals_reader", 1, "order_totals_lookup")]+      map (.name) owners `shouldBe` ["order_summary_writer", "shipment_writer", "audit_writer"]+      map (.checkpointOnMissing) owners `shouldBe` [[], [], [CheckpointFromCurrentHead]]++    it "validates and truthfully lowers every Language 5 delivery/freshness capability" $ do+      entireSource <- readTestText "test/fixtures/mapped-readmodel.keiro"+      categorySource <- readTestText "test/fixtures/declarative-router/valid.keiro"+      immediateSource <- readTestText "test/fixtures/projection-catalog.keiro"+      entireService <- checkedServiceFromText "projection-freshness-entire.keiro" entireSource+      categoryService <- checkedServiceFromText "projection-freshness-category.keiro" categorySource+      immediateService <- checkedServiceFromText "projection-freshness-immediate.keiro" immediateSource+      let errorsOf service = [diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]+      errorsOf entireService `shouldBe` []+      errorsOf categoryService `shouldBe` []+      errorsOf immediateService `shouldBe` []+      let generatedReadModel suffix service =+            generatedTextEndingIn suffix (scaffoldServiceModules (defaultContext ((checkedSpec service).context)) service)+          entireReadModel = generatedReadModel "AccountSummary/ReadModel.hs" entireService+          categoryReadModel = generatedReadModel "HospitalLoad/ReadModel.hs" categoryService+          immediateReadModelText = generatedReadModel "CatalogAudit/ReadModel.hs" immediateService+          inlineReadModel = generatedReadModel "OrderInline/ReadModel.hs" immediateService+      entireReadModel `shouldSatisfy` T.isInfixOf "headWaitingReadModel EntireVisibleLog"+      entireReadModel `shouldSatisfy` T.isInfixOf "DurableQueryCursor \"mapped-readmodel-account-summary\""+      categoryReadModel `shouldSatisfy` T.isInfixOf "headWaitingReadModel (CategoryVisibleHead \"hospitalLoad\")"+      categoryReadModel `shouldSatisfy` T.isInfixOf "DurableQueryCursor \"declarative-router-hospital-load\""+      immediateReadModelText `shouldSatisfy` T.isInfixOf "immediateReadModel catalogAuditReadModelBlueprint"+      immediateReadModelText `shouldSatisfy` T.isInfixOf "DurableQueryCursor \"catalog-demo-audit\""+      inlineReadModel `shouldSatisfy` T.isInfixOf "immediateReadModel orderInlineReadModelBlueprint"+      inlineReadModel `shouldSatisfy` T.isInfixOf "cursorAuthority = NoQueryCursor"+      forM_ [entireReadModel, categoryReadModel, immediateReadModelText, inlineReadModel] $ \generated -> do+        generated `shouldNotSatisfy` T.isInfixOf "defaultConsistency"+        generated `shouldNotSatisfy` T.isInfixOf "strongScope"+        generated `shouldNotSatisfy` T.isInfixOf "subscriptionName ="++    it "rejects unavailable or unreachable head waits before generation" $ do+      catalogSource <- readTestText "test/fixtures/projection-catalog.keiro"+      categorySource <- readTestText "test/fixtures/declarative-router/valid.keiro"+      let codesFor name source = do+            service <- checkedServiceFromText name source+            pure [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]+          inlineWait =+            T.replace+              "shape = \"fnv1a:784e511a19f74c58\"\n  freshness = immediate\n  group = reporting\n  targets = [ order_summary ]"+              "shape = \"fnv1a:784e511a19f74c58\"\n  freshness = wait-for-head category \"orders\"\n  group = reporting\n  targets = [ order_summary ]"+              catalogSource+          mismatchedCategory =+            T.replace+              "freshness = wait-for-head category \"hospitalLoad\""+              "freshness = wait-for-head category \"other\""+              categorySource+          missingCursor = T.replace "  subscription = \"declarative-router-hospital-load\"\n" "" categorySource+      codesFor "projection-freshness-inline-wait.keiro" inlineWait+        `shouldReturn` [CatalogQueryWaitWithoutCompatibleCursor]+      codesFor "projection-freshness-mismatched-category.keiro" mismatchedCategory+        `shouldReturn` [CatalogQueryWaitWithoutCompatibleCursor]+      missingCursorCodes <- codesFor "projection-freshness-missing-cursor.keiro" missingCursor+      missingCursorCodes `shouldContain` [CatalogAsyncIdentityMissing]+      missingCursorCodes `shouldContain` [CatalogQueryWaitWithoutCompatibleCursor]++      mappedSource <- mappedConsumerSurfaceSource+      let implicitOwner =+            T.replace+              "  wire kind=ctorName fields=camelCase schemaVersion=1\n"+              "  wire kind=ctorName fields=camelCase schemaVersion=1\n\n  projection ArtifactLookup key=currentArtifact\n    status-map { ArtifactObserved=>observed }\n"+              ( T.replace+                  "freshness = immediate"+                  "freshness = wait-for-head category \"catalog\""+                  mappedSource+              )+      implicitCodes <- codesFor "projection-freshness-implicit-owner.keiro" implicitOwner+      implicitCodes `shouldContain` [CatalogQueryWaitWithoutCompatibleCursor]++    it "rejects the earlier Language 5 spellings with migration guidance" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      let failureText name candidate = case parseSource name candidate of+            Left failure -> pure (renderParseFailure failure)+            Right _ -> expectationFailure (name <> " unexpectedly parsed") >> fail "unreachable"+      readModelFailure <-+        failureText+          "projection-freshness-legacy-readmodel.keiro"+          ( T.replace+              "  freshness = immediate"+              "  consistency = Strong\n  scope = entire-log\n  feed = subscription\n  subscription = \"catalog-demo-audit\""+              source+          )+      readModelFailure `shouldSatisfy` T.isInfixOf "remove legacy `consistency`"+      ownerFailure <-+        failureText+          "projection-freshness-legacy-owner.keiro"+          (T.replace "  delivery = subscription" "  feed = subscription" source)+      ownerFailure `shouldSatisfy` T.isInfixOf "replace legacy `feed`"++      mappedSource <- mappedConsumerSurfaceSource+      aggregateFailure <-+        failureText+          "projection-freshness-legacy-inner.keiro"+          ( T.replace+              "  wire kind=ctorName fields=camelCase schemaVersion=1\n"+              "  wire kind=ctorName fields=camelCase schemaVersion=1\n\n  projection ArtifactLookup consistency=Eventual key=currentArtifact\n    status-map { ArtifactObserved=>observed }\n"+              mappedSource+          )+      aggregateFailure `shouldSatisfy` T.isInfixOf "put `freshness` on the referenced readmodel"++    it "isolates freshness evolution from delivery, table shape, sources, and aggregate folds" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      baseline <- checkedServiceFromText "projection-freshness-baseline.keiro" source+      changed <-+        checkedServiceFromText+          "projection-freshness-changed.keiro"+          ( T.replace+              "shape = \"fnv1a:9682af3ada04bf50\"\n  freshness = immediate\n  group = reporting\n  targets = [ audit_log ]"+              "shape = \"fnv1a:9682af3ada04bf50\"\n  freshness = wait-for-head category \"audit\"\n  group = reporting\n  targets = [ audit_log ]"+              source+          )+      validateService changed `shouldBe` []+      let changeCodes = map ((.code) . kindOfChange) (diffServices baseline changed)+          foldIdentities service =+            [ ((.name) aggregate, aggregateFoldFingerprintForService service aggregate)+            | NAggregate aggregate <- (.nodes) (checkedSpec service)+            ]+          sourceIdentities service =+            [ ((.name) aggregate, ProjectionImpact.projectionAggregateSourceFingerprintForService service ((.name) aggregate))+            | NAggregate aggregate <- (.nodes) (checkedSpec service)+            ]+          catalogAudit service = case [readModel | NReadModel readModel <- (.nodes) (checkedSpec service), (.name) readModel == "catalogAudit"] of+            [readModel] -> readModel+            values -> error ("expected one catalogAudit read model, got " <> show (length values))+          nonFreshnessFacts = filter (not . T.isPrefixOf "freshness|") . projectionCatalogFactsForService+          freshnessFacts = filter (T.isPrefixOf "freshness|") . projectionCatalogFactsForService+      changeCodes `shouldContain` [QueryFreshnessChanged]+      changeCodes `shouldNotContain` [ProjectionDeliveryChanged, ReadModelShapeChangedWithoutBump, CatalogSourceChanged]+      foldIdentities changed `shouldBe` foldIdentities baseline+      sourceIdentities changed `shouldBe` sourceIdentities baseline+      deriveShapeHash (catalogAudit changed) `shouldBe` deriveShapeHash (catalogAudit baseline)+      nonFreshnessFacts changed `shouldBe` nonFreshnessFacts baseline+      freshnessFacts changed `shouldNotBe` freshnessFacts baseline++    it "resolves one inline owner for several query models without legacy aggregate clauses" $ do+      source <- readTestText "test/fixtures/projection-owner-multi-query.keiro"+      service <- checkedServiceFromText "projection-owner-multi-query.keiro" source+      validateService service `shouldBe` []+      let analysis = analyzeProjectionSupplies (checkedSpec service)+          supplies = (.resolvedProjectionSupplies) analysis+      (.projectionSupplyIssues) analysis `shouldBe` []+      map (.queryModel) supplies+        `shouldBe` ["catalog_administration", "catalog_validation"]+      map (.projectionOwner) supplies+        `shouldBe` ["catalog_writer", "catalog_writer"]+      map (NE.toList . (.observedTargets)) supplies+        `shouldBe` [["catalog_keys"], ["catalog_layouts", "catalog_state"]]++      reordered <-+        checkedServiceFromText+          "projection-owner-multi-query-reordered.keiro"+          ( T.replace+              "targets = [ catalog_state catalog_layouts ]"+              "targets = [ catalog_layouts catalog_state ]"+              ( T.replace+                  "targets = [ catalog_state catalog_layouts catalog_keys ]\n  order = 10"+                  "targets = [ catalog_keys catalog_layouts catalog_state ]\n  order = 10"+                  source+              )+          )+      validateService reordered `shouldBe` []+      (.resolvedProjectionSupplies) (analyzeProjectionSupplies (checkedSpec reordered))+        `shouldBe` supplies++    it "diagnoses invalid query supply and catalog/legacy double ownership deterministically" $ do+      source <- readTestText "test/fixtures/projection-owner-multi-query.keiro"+      let diagnosticsForSource caseName mutated = do+            service <- checkedServiceFromText caseName mutated+            pure (validateService service)+          codesForSource caseName mutated = map (.code) <$> diagnosticsForSource caseName mutated+          splitOwnerMutation =+            T.replace+              "targets = [ catalog_state catalog_layouts ]\n  backing = catalog_state"+              "targets = [ catalog_state catalog_layouts catalog_keys ]\n  backing = catalog_state"+              . T.replace+                "  replay = explicit\n}\n\nreadmodel catalog_validation"+                "  replay = explicit\n}\n\nprojection-owner catalog_keys_writer {\n  source = aggregate Catalog\n  delivery = inline\n  group = catalog_group\n  targets = [ catalog_keys ]\n  order = 20\n  replay = explicit\n}\n\nreadmodel catalog_validation"+              . T.replace+                "targets = [ catalog_state catalog_layouts catalog_keys ]\n  order = 10"+                "targets = [ catalog_state catalog_layouts ]\n  order = 10"+      emptyCodes <- codesForSource "projection-owner-empty-query.keiro" (T.replace "targets = [ catalog_keys ]" "targets = [ ]" source)+      emptyCodes `shouldContain` [CatalogReadModelBindingMissing]+      unknownCodes <- codesForSource "projection-owner-unknown-query-target.keiro" (T.replace "targets = [ catalog_keys ]" "targets = [ missing_target ]" source)+      unknownCodes `shouldContain` [CatalogTargetUnknown]+      missingCodes <- codesForSource "projection-owner-missing-query-owner.keiro" (T.replace "targets = [ catalog_state catalog_layouts catalog_keys ]\n  order = 10" "targets = [ catalog_state catalog_layouts ]\n  order = 10" source)+      missingCodes `shouldContain` [CatalogTargetUnowned]++      splitDiagnostics <- diagnosticsForSource "projection-owner-split-query.keiro" (splitOwnerMutation source)+      map (.code) splitDiagnostics `shouldContain` [CatalogReadModelMultipleSuppliers]+      let splitSupplyDiagnostics = filter ((== CatalogReadModelMultipleSuppliers) . (.code)) splitDiagnostics+      map (map snd . (.relatedLocations)) splitSupplyDiagnostics+        `shouldBe` [ [ "projection owner 'catalog_keys_writer' supplies part of the observed target set",+                       "projection owner 'catalog_writer' supplies part of the observed target set"+                     ]+                   ]+      reorderedSplitDiagnostics <-+        diagnosticsForSource+          "projection-owner-split-query-reordered.keiro"+          ( T.replace+              "targets = [ catalog_state catalog_layouts catalog_keys ]"+              "targets = [ catalog_keys catalog_layouts catalog_state ]"+              (splitOwnerMutation source)+          )+      map (\diagnostic -> ((.code) diagnostic, map snd ((.relatedLocations) diagnostic))) reorderedSplitDiagnostics+        `shouldContain` map (\diagnostic -> ((.code) diagnostic, map snd ((.relatedLocations) diagnostic))) splitSupplyDiagnostics++      groupMismatchCodes <-+        codesForSource+          "projection-owner-group-mismatch.keiro"+          ( T.replace+              "targets = [ catalog_state catalog_layouts catalog_keys ]\n  order = [ catalog_state catalog_layouts catalog_keys ]\n}"+              "targets = [ catalog_state catalog_layouts ]\n  order = [ catalog_state catalog_layouts ]\n}\n\nrebuild-group catalog_keys_group {\n  targets = [ catalog_keys ]\n  order = [ catalog_keys ]\n}"+              source+          )+      groupMismatchCodes `shouldContain` [CatalogReadModelTargetOutsideGroup]+      groupMismatchCodes `shouldContain` [CatalogProjectionTargetOutsideGroup]++      conflictDiagnostics <-+        diagnosticsForSource+          "projection-owner-legacy-conflict.keiro"+          ( T.replace+              "  wire kind=ctorName fields=camelCase schemaVersion=1"+              "  wire kind=ctorName fields=camelCase schemaVersion=1\n\n  projection catalog_validation key=version\n    status-map { Activated=>active }"+              source+          )+      let conflicts = filter ((== CatalogReadModelLegacyProjectionConflict) . (.code)) conflictDiagnostics+      length conflicts `shouldBe` 1+      conflicts `shouldSatisfy` all ((== 1) . length . (.relatedLocations))+      conflicts `shouldSatisfy` all (T.isInfixOf "remove the legacy aggregate projection clause" . (.message))++    it "derives and restores mapped projection impact for the compiled A/B catalog fixture" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      service <- checkedServiceFromText "projection-catalog.keiro" source+      baseImpact <- case ProjectionImpact.projectionMappedImpactForService service of+        Nothing -> expectationFailure "projection fixture type graph did not resolve" >> fail "unreachable"+        Just value -> pure value+      ProjectionImpact.projectionConsumersFor baseImpact (MappedKey "OrderPayload")+        `shouldBe` Set.singleton (CatalogProjectionConsumer "order_summary_writer" "Orders")+      ProjectionImpact.projectionConsumersFor baseImpact (MappedKey "SharedReference")+        `shouldBe` Set.fromList+          [ CatalogProjectionConsumer "order_summary_writer" "Orders",+            CatalogProjectionConsumer "shipment_writer" "Shipments"+          ]+      (.unsupported) baseImpact+        `shouldBe` [ ProjectionImpact.UnsupportedProjectionImpact+                       (UnsupportedCatalogCategory "audit_writer" "audit")+                       "reporting"+                       (Set.singleton "audit_log")+                       (Set.singleton "catalogAudit")+                       True+                   ]+      let rendered = ProjectionImpact.renderProjectionMappedImpact baseImpact+      rendered `shouldContain` ["      inherited event roots: Orders event OrderRecorded .orderPayload : OrderPayload"]+      rendered+        `shouldContain` ["      operation: group=shipping; targets=shipment_summary; read-models=shipmentLookup; replayable=no; source-fingerprint=aggregate:Shipments/generated-codec/v1/mapped-9456a95e380c74b5"]+      rendered `shouldContain` ["    catalog-category:audit_writer:audit"]++      eventChanged <- checkedServiceFromText "projection-catalog-event-changed.keiro" (T.replace "version = \"1\"" "version = \"2\"" source)+      sourceChanged <- checkedServiceFromText "projection-catalog-source-changed.keiro" (T.replace "source = aggregate Orders" "source = aggregate Shipments" source)+      replayChanged <- checkedServiceFromText "projection-catalog-replay-changed.keiro" (T.replace "replay = live-only \"carrier events cannot be replayed\"" "replay = explicit" source)+      observationChanged <- checkedServiceFromText "projection-catalog-observation-changed.keiro" (T.replace "targets = [ order_summary ]" "targets = [ audit_log ]" source)+      categoryChanged <- checkedServiceFromText "projection-catalog-category-changed.keiro" (T.replace "source = category \"audit\"" "source = category \"archive-audit\"" source)+      let requireImpact caseLabel candidate = case ProjectionImpact.projectionMappedImpactForService candidate of+            Nothing -> expectationFailure (caseLabel <> " type graph did not resolve") >> fail "unreachable"+            Just value -> pure value+          findOperation derived impact =+            Map.lookup derived ((.operations) impact)+          operationReplay (ProjectionImpact.ProjectionOperationalImpact _ _ _ _ canReplay _) = canReplay+          operationObservers (ProjectionImpact.ProjectionOperationalImpact _ _ _ observers _ _) = observers+          operationFingerprint (ProjectionImpact.ProjectionOperationalImpact _ _ _ _ _ fingerprint) = fingerprint+      eventImpact <- requireImpact "event mutation" eventChanged+      sourceImpact <- requireImpact "source mutation" sourceChanged+      replayImpact <- requireImpact "replay mutation" replayChanged+      observationImpact <- requireImpact "observation mutation" observationChanged+      categoryImpact <- requireImpact "category mutation" categoryChanged+      operationFingerprint <$> findOperation (CatalogProjectionConsumer "order_summary_writer" "Orders") eventImpact+        `shouldNotBe` operationFingerprint <$> findOperation (CatalogProjectionConsumer "order_summary_writer" "Orders") baseImpact+      ProjectionImpact.projectionConsumersFor sourceImpact (MappedKey "OrderPayload")+        `shouldBe` Set.empty+      operationReplay <$> findOperation (CatalogProjectionConsumer "shipment_writer" "Shipments") replayImpact+        `shouldBe` Just True+      operationObservers <$> findOperation (CatalogProjectionConsumer "order_summary_writer" "Orders") observationImpact+        `shouldBe` Just (Set.singleton "order_totals_lookup")+      map (.source) ((.unsupported) categoryImpact)+        `shouldBe` [UnsupportedCatalogCategory "audit_writer" "archive-audit"]+      restored <- checkedServiceFromText "projection-catalog-restored.keiro" source >>= requireImpact "restored fixture"+      restored `shouldBe` baseImpact++    it "feature-gates catalog declarations before validation in languages 1-4" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      case parseSource "projection-catalog-v4.keiro" (T.replace "language keiro-dsl 5" "language keiro-dsl 4" source) of+        Left failure -> do+          renderParseFailure failure `shouldSatisfy` T.isInfixOf "LanguageFeatureRequiresVersion"+          renderParseFailure failure `shouldSatisfy` T.isInfixOf "requires keiro-dsl language version 5"+        Right _ -> expectationFailure "language 4 accepted projection-catalog syntax"++    it "keeps the catalog structural guards live" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      let mutationCodes mutation = do+            service <- checkedServiceFromText "projection-catalog-mutation.keiro" (mutation source)+            pure (map (.code) (validateService service))+          revisionV2AuditBlock =+            T.unlines+              [ "  target audit_log {",+                "    schema-version = \"v2\"",+                "    provisioner = \"reporting-v2-audit-log\"",+                "    provisioner-version = 1",+                "    expected-shape = \"audit-log-v2\"",+                "    validator = \"reporting-v2-audit-log-validator\"",+                "    validator-version = 1",+                "    promotion owned-sequence \"audit_log_id_seq__v2\" -> \"audit_log_id_seq\"",+                "  }"+              ]+      missingAsyncIdentity <- mutationCodes (T.replace "  subscription = \"catalog-demo-audit\"\n" "")+      missingAsyncIdentity `shouldContain` [CatalogAsyncIdentityMissing]+      missingCheckpointPolicy <- mutationCodes (T.replace "  checkpoint-on-missing = from-current-head\n" "")+      missingCheckpointPolicy `shouldContain` [CatalogCheckpointPolicyMissing]+      duplicateCheckpointPolicy <- mutationCodes (T.replace "  checkpoint-on-missing = from-current-head\n" "  checkpoint-on-missing = from-current-head\n  checkpoint-on-missing = fail\n")+      duplicateCheckpointPolicy `shouldContain` [CatalogCheckpointPolicyDuplicate]+      unexpectedInlineCheckpointPolicy <- mutationCodes (T.replace "  order = 10\n  replay = explicit" "  order = 10\n  checkpoint-on-missing = from-beginning\n  replay = explicit")+      unexpectedInlineCheckpointPolicy `shouldContain` [CatalogCheckpointPolicyUnexpected]+      replayUnsafeCheckpointPolicy <- mutationCodes (T.replace "table = \"audit_log\"\n  reset = preserve" "table = \"audit_log\"\n  reset = clear")+      replayUnsafeCheckpointPolicy `shouldContain` [CatalogCheckpointPolicyReplayUnsafe]+      case parseSource "projection-catalog-unknown-checkpoint-policy.keiro" (T.replace "checkpoint-on-missing = from-current-head" "checkpoint-on-missing = newest" source) of+        Left failure -> do+          let rendered = renderParseFailure failure+          rendered `shouldSatisfy` T.isInfixOf "unknown checkpoint-on-missing policy"+          rendered `shouldSatisfy` T.isInfixOf "from-beginning"+          rendered `shouldSatisfy` T.isInfixOf "from-current-head"+          rendered `shouldSatisfy` T.isInfixOf "fail"+        Right _ -> expectationFailure "unknown checkpoint-on-missing value parsed successfully"+      forM_ ["from-beginning", "fail"] $ \policy -> do+        acceptedPolicy <- mutationCodes (T.replace "checkpoint-on-missing = from-current-head" ("checkpoint-on-missing = " <> policy))+        acceptedPolicy `shouldNotContain` [CatalogCheckpointPolicyMissing, CatalogCheckpointPolicyDuplicate, CatalogCheckpointPolicyUnexpected, CatalogCheckpointPolicyReplayUnsafe]+        acceptedClearPolicy <- mutationCodes (T.replace "table = \"audit_log\"\n  reset = preserve" "table = \"audit_log\"\n  reset = clear" . T.replace "checkpoint-on-missing = from-current-head" ("checkpoint-on-missing = " <> policy))+        acceptedClearPolicy `shouldNotContain` [CatalogCheckpointPolicyReplayUnsafe]+      unsafeLiveOnly <- mutationCodes (T.replace "  replay = explicit\n}" "  replay = live-only \"external side effect\"\n}")+      unsafeLiveOnly `shouldContain` [CatalogClearTargetLiveOnly]+      duplicateOrder <- mutationCodes (T.replace "  order = 20\n" "  order = 10\n")+      duplicateOrder `shouldContain` [CatalogDuplicateHandlerOrder]+      badGroupOrder <- mutationCodes (T.replace "  order = [ order_summary order_totals audit_log ]" "  order = [ order_summary order_summary audit_log ]")+      badGroupOrder `shouldContain` [CatalogGroupOrderMismatch]+      missingOwner <- mutationCodes (T.replace "  targets = [ order_summary order_totals ]\n" "  targets = [ order_summary ]\n")+      missingOwner `shouldContain` [CatalogTargetUnowned]+      unknownDependency <- mutationCodes (T.replace "  depends-on = [ order_summary ]\n" "  depends-on = [ missing_target ]\n")+      unknownDependency `shouldContain` [CatalogTargetDependencyUnknown]+      dependencyCycle <- mutationCodes (T.replace "  reset = clear\n}\n\ntarget audit_log" "  reset = clear\n  depends-on = [ order_totals ]\n}\n\ntarget audit_log")+      dependencyCycle `shouldContain` [CatalogTargetDependencyCycle]+      overlappingSource <- mutationCodes (T.replace "  source = aggregate Orders\n" "  source = aggregate Orders\n  source = category \"orders\"\n")+      overlappingSource `shouldContain` [CatalogSourceOverlap]+      ambiguousSourceOrdering <- mutationCodes (T.replace "  source = category \"audit\"\n" "  source = all\n")+      ambiguousSourceOrdering `shouldContain` [CatalogAmbiguousSourceOrdering]+      missingQueryBinding <- mutationCodes (T.replace "  targets = [ audit_log ]\n}\n\nprojection-owner audit_writer" "  targets = [ order_summary ]\n}\n\nprojection-owner audit_writer")+      missingQueryBinding `shouldContain` [CatalogAsyncQueryBindingMissing]+      missingRevisionTarget <- mutationCodes (T.replace "  target audit_log {\n    schema-version = \"v2\"" "  target missing_target {\n    schema-version = \"v2\"")+      missingRevisionTarget `shouldContain` [CatalogRevisionTargetUnknown, CatalogRevisionTargetSetMismatch]+      incompleteRevision <- mutationCodes (T.replace revisionV2AuditBlock "")+      incompleteRevision `shouldContain` [CatalogRevisionTargetSetMismatch]+      invalidRevisionIdentity <- mutationCodes (T.replace "provisioner-version = 1" "provisioner-version = 0")+      invalidRevisionIdentity `shouldContain` [CatalogRevisionIdentityInvalid]+      invalidContractVersion <- mutationCodes (T.replace "external-read order_totals_reader {\n  version = 1" "external-read order_totals_reader {\n  version = 0")+      invalidContractVersion `shouldContain` [CatalogExternalReadVersionInvalid]+      missingExternalQuery <- mutationCodes (T.replace "query = order_totals_lookup" "query = missing_query")+      missingExternalQuery `shouldContain` [CatalogExternalReadQueryUnknown]+      multiTargetExternalQuery <- mutationCodes (T.replace "  targets = [ order_totals ]\n}\n\nexternal-read" "  targets = [ order_summary order_totals ]\n  backing = order_totals\n}\n\nexternal-read")+      multiTargetExternalQuery `shouldContain` [CatalogExternalReadTargetCardinalityInvalid]+      emptyCompatibility <- mutationCodes (T.replace "compatible-revisions = [ reporting_v1 reporting_v2 ]" "compatible-revisions = [ ]")+      emptyCompatibility `shouldContain` [CatalogExternalReadCompatibilityInvalid]+      unknownCompatibleRevision <- mutationCodes (T.replace "compatible-revisions = [ reporting_v1 reporting_v2 ]" "compatible-revisions = [ missing_revision ]")+      unknownCompatibleRevision `shouldContain` [CatalogExternalReadRevisionUnknown]+      wrongRevisionGroup <- mutationCodes (T.replace "query = order_totals_lookup" "query = shipmentLookup")+      wrongRevisionGroup `shouldContain` [CatalogExternalReadRevisionGroupMismatch]+      invalidResultIdentity <- mutationCodes (T.replace "result-schema = \"app_contract\"" "result-schema = \"app-contract\"")+      invalidResultIdentity `shouldContain` [CatalogExternalReadIdentityInvalid]+      invalidSurfaceGeneration <- mutationCodes (T.replace "surface-generation = 1" "surface-generation = 0")+      invalidSurfaceGeneration `shouldContain` [CatalogExternalReadSurfaceGenerationInvalid]++    it "generates one facade, one create-once behavior surface, and durable ledger facts" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      service <- checkedServiceFromText "projection-catalog.keiro" source+      let spec = checkedSpec service+          modules = scaffoldServiceModules (defaultContext (spec.context)) service+          facade = generatedTextEndingIn "Generated/CatalogDemo/ProjectionCatalog.hs" modules+          holes = case [(.text) m | m <- modules, (.kind) m == HoleStub, "ProjectionCatalog/ProjectionCatalogHoles.hs" `T.isSuffixOf` T.pack ((.path) m)] of+            [value] -> value+            values -> error ("expected one projection catalog hole module, got " <> show (length values))+          facts = projectionCatalogFactsForService service+      facade `shouldSatisfy` T.isInfixOf "Catalog.validateProjectionCatalog projectionCatalog"+      facade `shouldSatisfy` T.isInfixOf "Catalog.ClearBeforeReplay"+      facade `shouldSatisfy` T.isInfixOf "Catalog.PreserveAndReconcile"+      facade `shouldSatisfy` T.isInfixOf "KirokuSubscription.FromCurrentHead"+      facade `shouldSatisfy` T.isInfixOf "Catalog.ProjectionRevision (must (Catalog.mkProjectionRevisionId \"reporting_v1\"))"+      facade `shouldSatisfy` T.isInfixOf "Catalog.TargetSchemaVersion \"v2\""+      facade `shouldSatisfy` T.isInfixOf "Catalog.AllRowsExternalRead (must (Catalog.mkExternalReadContractId \"order_totals_reader\"))"+      facade `shouldSatisfy` T.isInfixOf "Catalog.QualifiedSqlType \"app_contract\" \"order_totals_row_v1\""+      facade `shouldSatisfy` T.isInfixOf "\"fnv1a:768a23d719dcb4d4\""+      facade `shouldSatisfy` T.isInfixOf "projectionCatalogQuerySupplies = Catalog.resolvedQuerySupplies validatedProjectionCatalog"+      facade `shouldSatisfy` T.isInfixOf "ordersInlineProjections = concat [orderSummaryWriterInlineProjections]"+      facade+        `shouldSatisfy` ( \text ->+                            let (_, fromFirst) = T.breakOn "orderSummaryWriterProjectionSet" text+                             in not (T.null fromFirst) && T.isInfixOf "auditWriterProjectionSet" (T.drop 1 fromFirst)+                        )+      holes `shouldSatisfy` T.isInfixOf "fill order_summary_writer live apply"+      holes `shouldSatisfy` T.isInfixOf "fill order_summary_writer replay apply"+      holes `shouldSatisfy` T.isInfixOf "provisionReportingV2OrderSummary :: Catalog.TargetProvisioningContext"+      holes `shouldSatisfy` T.isInfixOf "applyReportingV2OrderSummaryWriterLive :: Catalog.PhysicalTargets"+      holes `shouldSatisfy` T.isInfixOf "applyReportingV2AuditWriterLive :: Catalog.PhysicalTargets"+      holes `shouldSatisfy` T.isInfixOf "orderTotalsReaderV1KeyedExternalRead :: [Catalog.SqlFunctionArgument]"+      holes `shouldSatisfy` T.isInfixOf "application-owned private SQL function"+      facts `shouldBe` sort facts+      facts `shouldSatisfy` any (T.isPrefixOf "target|order_summary|")+      facts `shouldSatisfy` any (T.isPrefixOf "owner|audit_writer|")+      facts `shouldSatisfy` any (T.isPrefixOf "delivery|audit_writer|subscription|")+      facts `shouldSatisfy` any (T.isPrefixOf "revision|reporting_v1|reporting|")+      facts `shouldSatisfy` any (T.isPrefixOf "external-read|order_totals_reader|1|order_totals_lookup|app_contract.order_totals_row_v1|fnv1a:768a23d719dcb4d4|reporting_v1,reporting_v2|1|")+      facts `shouldSatisfy` any (T.isInfixOf "order_summary,v2,reporting-v2-order-summary")+      facts `shouldSatisfy` any (T.isPrefixOf "freshness|catalogAudit|immediate|")+      facts `shouldSatisfy` any (T.isPrefixOf "cursor|catalogAudit|catalog-demo-audit|")+      facts `shouldSatisfy` any (T.isPrefixOf "query|order_totals_lookup|reporting|order_totals|order_totals|")+      facts `shouldSatisfy` any (T.isPrefixOf "supply|order_inline|order_summary_writer|reporting|order_summary|")+      facts `shouldSatisfy` any (T.isPrefixOf "supply|order_totals_lookup|order_summary_writer|reporting|order_totals|")+      facts `shouldSatisfy` any (T.isInfixOf "|from-current-head|explicit|")++    it "distinguishes external-read versioning, retirement, compatibility, and derived result-shape changes" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      baseline <- checkedServiceFromText "projection-catalog-external-read.keiro" source+      let externalReadBlock version resultType =+            T.unlines+              [ "external-read order_totals_reader {",+                "  version = " <> T.pack (show version),+                "  query = order_totals_lookup",+                "  result-schema = \"app_contract\"",+                "  result-type = \"" <> resultType <> "\"",+                "  compatible-revisions = [ reporting_v1 reporting_v2 ]",+                "  surface-generation = 1",+                "}",+                ""+              ]+          v1Block = externalReadBlock (1 :: Int) "order_totals_row_v1"+          codes candidate = map ((.code) . kindOfChange) (diffServices baseline candidate)+      versionAdded <-+        checkedServiceFromText+          "projection-catalog-external-read-v2.keiro"+          (T.replace v1Block (v1Block <> externalReadBlock (2 :: Int) "order_totals_row_v2") source)+      retired <- checkedServiceFromText "projection-catalog-external-read-retired.keiro" (T.replace v1Block "" source)+      compatibilityChanged <-+        checkedServiceFromText+          "projection-catalog-external-read-compatible.keiro"+          (T.replace "compatible-revisions = [ reporting_v1 reporting_v2 ]" "compatible-revisions = [ reporting_v1 ]" source)+      shapeChanged <-+        checkedServiceFromText+          "projection-catalog-external-read-shape.keiro"+          (T.replace "shape = \"fnv1a:768a23d719dcb4d4\"" "shape = \"fnv1a:0000000000000000\"" source)+      validateService versionAdded `shouldBe` []+      codes versionAdded `shouldContain` [CatalogExternalReadVersionAdded]+      codes retired `shouldContain` [CatalogExternalReadRetired]+      codes compatibilityChanged `shouldContain` [CatalogExternalReadCompatibilityChanged]+      codes shapeChanged `shouldContain` [CatalogExternalReadResultShapeChanged]++      reordered <-+        checkedServiceFromText+          "projection-catalog-external-read-reordered.keiro"+          (T.replace "compatible-revisions = [ reporting_v1 reporting_v2 ]" "compatible-revisions = [ reporting_v2 reporting_v1 ]" source)+      projectionCatalogFactsForService reordered `shouldBe` projectionCatalogFactsForService baseline+      codes reordered `shouldNotContain` [CatalogExternalReadCompatibilityChanged]++    it "preserves edited catalog behavior holes on regeneration" $+      withTempDirectory "keiro-dsl-projection-catalog-create-once" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/projection-catalog.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            holeSuffix = "ProjectionCatalog/ProjectionCatalogHoles.hs"+        modules <- case planTestServiceScaffold ctx service of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right planned -> pure planned+        first <- executeServiceScaffold out False "projection-catalog.keiro" ((.sourceLanguage) parsed) ctx service modules+        first `shouldSatisfy` isSuccessfulScaffold+        let path = out </> onlyPathEndingIn holeSuffix modules+            reviewedBody = "module CatalogDemo.ProjectionCatalog.ProjectionCatalogHoles where\nreviewed = True\n"+        TIO.writeFile path reviewedBody+        second <- executeServiceScaffold out False "projection-catalog.keiro" ((.sourceLanguage) parsed) ctx service modules+        second `shouldSatisfy` isSuccessfulScaffold+        TIO.readFile path `shouldReturn` reviewedBody+        case second of+          Left _ -> fail "unreachable"+          Right report ->+            do+              (.dispositions) report+                `shouldSatisfy` any (\(moduleValue, disposition) -> holeSuffix `isSuffixOfPath` moduleValue && disposition == Skipped)+              renderScaffoldReport report+                `shouldContain` ["      inherited event roots: Orders event OrderRecorded .orderPayload : OrderPayload"]+              renderScaffoldReport report+                `shouldContain` ["      operation: group=shipping; targets=shipment_summary; read-models=shipmentLookup; replayable=no; source-fingerprint=aggregate:Shipments/generated-codec/v1/mapped-9456a95e380c74b5"]+              renderScaffoldReport report `shouldContain` ["    catalog-category:audit_writer:audit"]++    it "classifies every catalog evolution dimension and reports machine-readable replay impact" $ do+      source <- readTestText "test/fixtures/projection-catalog.keiro"+      oldService <- checkedServiceFromText "projection-catalog-old.keiro" source+      let targetBlock = T.unlines ["target audit_log {", "  schema = \"sales\"", "  table = \"audit_log\"", "  reset = preserve", "}", ""]+          ownerBlock =+            T.unlines+              [ "projection-owner audit_writer {",+                "  source = category \"audit\"",+                "  delivery = subscription",+                "  group = reporting",+                "  targets = [ audit_log ]",+                "  order = 20",+                "  subscription = \"catalog-demo-audit\"",+                "  dedup = \"catalog-demo-audit-v1\"",+                "  checkpoint-on-missing = from-current-head",+                "  replay = explicit",+                "}",+                ""+              ]+          mutations =+            [ ("target-added", CatalogTargetAdded, T.replace "rebuild-group reporting" "target archive_log {\n  schema = \"sales\"\n  table = \"archive_log\"\n  reset = preserve\n}\n\nrebuild-group reporting"),+              ("target-removed", CatalogTargetRemoved, T.replace targetBlock ""),+              ("target-location", CatalogTargetLocationChanged, T.replace "table = \"order_summary\"" "table = \"order_summary_v2\""),+              ("target-reset", CatalogTargetResetPolicyChanged, T.replace "reset = preserve" "reset = clear"),+              ("target-dependency", CatalogTargetDependencyChanged, T.replace "depends-on = [ order_summary ]" "depends-on = [ audit_log ]"),+              ("group-membership-order", CatalogGroupChanged, T.replace "order = [ order_summary order_totals audit_log ]" "order = [ audit_log order_summary order_totals ]"),+              ("revision-schema", CatalogTargetSchemaChanged, T.replace "schema-version = \"v2\"" "schema-version = \"v2.1\""),+              ("revision-provider", CatalogProjectionRevisionChanged, T.replace "provisioner = \"reporting-v2-order-summary\"" "provisioner = \"reporting-v2-order-summary-new\""),+              ("owner-binding", CatalogOwnerChanged, T.replace "targets = [ order_summary order_totals ]" "targets = [ order_summary ]"),+              ("owner-removed", CatalogOwnerRemoved, T.replace ownerBlock ""),+              ("handler-order", CatalogHandlerOrderChanged, T.replace "order = 20" "order = 30"),+              ("source", CatalogSourceChanged, T.replace "source = aggregate Orders" "source = category \"archived-orders\""),+              ("delivery", ProjectionDeliveryChanged, T.replace "delivery = subscription" "delivery = inline"),+              ("subscription", CatalogFeedIdentityChanged, T.replace "subscription = \"catalog-demo-audit\"" "subscription = \"catalog-demo-audit-v2\""),+              ("dedup", CatalogFeedIdentityChanged, T.replace "dedup = \"catalog-demo-audit-v1\"" "dedup = \"catalog-demo-audit-v2\""),+              ("checkpoint-policy", CatalogCheckpointPolicyChanged, T.replace "checkpoint-on-missing = from-current-head" "checkpoint-on-missing = fail"),+              ("replay-policy", CatalogReplayPolicyChanged, T.replace "replay = live-only \"carrier events cannot be replayed\"" "replay = explicit"),+              ("query-binding", CatalogQueryBindingChanged, T.replace "targets = [ audit_log ]\n}\n\nprojection-owner audit_writer" "targets = [ order_summary ]\n}\n\nprojection-owner audit_writer")+            ]+      changedServices <-+        forM mutations $ \(caseName, expectedCode, mutate) -> do+          changed <- checkedServiceFromText ("projection-catalog-" <> caseName <> ".keiro") (mutate source)+          map ((.code) . kindOfChange) (diffServices oldService changed) `shouldContain` [expectedCode]+          pure (caseName, changed)+      supplierChanged <-+        checkedServiceFromText+          "projection-catalog-supplier-changed.keiro"+          ( T.replace+              "projection-owner audit_writer"+              ( T.unlines+                  [ "projection-owner order_totals_writer {",+                    "  source = category \"orderTotals\"",+                    "  delivery = inline",+                    "  group = reporting",+                    "  targets = [ order_totals ]",+                    "  order = 15",+                    "  replay = explicit",+                    "}",+                    "",+                    "projection-owner audit_writer"+                  ]+              )+              (T.replace "targets = [ order_summary order_totals ]" "targets = [ order_summary ]" source)+          )+      validateService supplierChanged `shouldBe` []+      map ((.code) . kindOfChange) (diffServices oldService supplierChanged)+        `shouldContain` [CatalogQueryBindingChanged]+      sourceChanged <- case lookup "source" changedServices of+        Just changed -> pure changed+        Nothing -> expectationFailure "source mutation was not exercised" >> fail "unreachable"+      policyChanged <- case lookup "checkpoint-policy" changedServices of+        Just changed -> pure changed+        Nothing -> expectationFailure "checkpoint policy mutation was not exercised" >> fail "unreachable"+      let policyChanges = [change | change <- diffServices oldService policyChanged, (.code) (kindOfChange change) == CatalogCheckpointPolicyChanged]+      case policyChanges of+        [change] -> do+          let finding = kindOfChange change+              rendered = renderFinding change+              encoded = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReport defaultGate [change])))+          (.persistedIdentity) (finding.vector) `shouldBe` VCompatible+          (.consumerBuild) (finding.vector) `shouldBe` VBreaking+          (.rollout) (finding.vector) `shouldBe` Set.singleton RolloutStopTheWorld+          (.detail) finding `shouldSatisfy` T.isInfixOf "existing checkpoint rows remain unchanged"+          rendered `shouldSatisfy` T.isInfixOf "from-current-head -> fail"+          rendered `shouldSatisfy` T.isInfixOf "rollout=stop-the-world"+          encoded `shouldSatisfy` T.isInfixOf "CatalogCheckpointPolicyChanged"+          encoded `shouldSatisfy` T.isInfixOf "from-current-head -> fail"+          encoded `shouldSatisfy` T.isInfixOf "\"persisted-identity\":\"compatible\""+          encoded `shouldSatisfy` T.isInfixOf "\"rollout\":[\"stop-the-world\"]"+        changes -> expectationFailure ("expected one checkpoint-policy finding, got " <> show (length changes))+      case ReplayImpact.catalogReplayImpactServices oldService policyChanged of+        CatalogReplayAffected groups targets sources adapters invalidates -> do+          groups `shouldBe` Set.singleton "reporting"+          targets `shouldBe` Set.singleton "audit_log"+          sources `shouldBe` Set.singleton "category:audit"+          adapters `shouldBe` Set.singleton "audit_writer"+          invalidates `shouldBe` True+        CatalogReplayNeutral -> expectationFailure "checkpoint-policy change was replay-neutral"+      case ReplayImpact.catalogReplayImpactServices oldService sourceChanged of+        CatalogReplayAffected groups targets sources adapters invalidates -> do+          groups `shouldBe` Set.singleton "reporting"+          targets `shouldBe` Set.fromList ["order_summary", "order_totals"]+          sources `shouldBe` Set.fromList ["aggregate:Orders", "category:archived-orders"]+          adapters `shouldBe` Set.singleton "order_summary_writer"+          invalidates `shouldBe` True+        CatalogReplayNeutral -> expectationFailure "catalog source change was replay-neutral"++  describe "ID domain" $ do+    let parseRight name source = case parseSource name source of+          Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+          Right value -> pure value++    it "registers language 3 as the first enforced runtime contract" $ do+      parsed <- case parseSource "id-domain-v3.keiro" "language keiro-dsl 3\ncontext id-domain\n" of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let contract = checkedLanguageContract (checkedSource parsed)+      effectiveRuntimeSemantics contract `shouldBe` "keiro-dsl/runtime-semantics/2"+      (.contractLanguageVersion) contract `shouldBe` maybe (error "missing v3") id (languageVersion 3)+      idDomainContractFor contract "req" `shouldSatisfy` (/= Nothing)++    it "registers language 4 as contract admission semantics without changing aggregate ID admission" $ do+      v3 <- parseRight "id-domain-v3.keiro" "language keiro-dsl 3\ncontext id-domain\n"+      v4 <- parseRight "id-domain-v4.keiro" "language keiro-dsl 4\ncontext id-domain\n"+      let v3Contract = checkedLanguageContract (checkedSource v3)+          v4Contract = checkedLanguageContract (checkedSource v4)+      effectiveRuntimeSemantics v4Contract `shouldBe` "keiro-dsl/runtime-semantics/3"+      (.contractLanguageVersion) v4Contract `shouldBe` maybe (error "missing v4") id (languageVersion 4)+      idDomainContractFor v4Contract "req" `shouldBe` idDomainContractFor v3Contract "req"+      contractIdDomainContractFor v3Contract "req" `shouldBe` Nothing+      contractIdDomainContractFor v4Contract "req" `shouldBe` Just (typeIdV7Domain "req")++    it "constructs typed KindIDs only after the frozen four-way admission policy" $ do+      let valid = "req_01h455vb4pex5vsknk084sn02q"+          uppercase = "req_01H455VB4PEX5VSKNK084SN02Q"+          nonV7 = "req_00041061050r3gg28a1c60t3gf"+      (KindID.toText @"req" <$> parseKindIdV7Text @"req" valid) `shouldBe` Right valid+      parseKindIdV7Text @"req" "req-1" `shouldSatisfy` \case+        Left IdDomainMalformed {} -> True+        _ -> False+      parseKindIdV7Text @"req" "other_01h455vb4pex5vsknk084sn02q" `shouldSatisfy` \case+        Left (IdDomainWrongPrefix "req" "other") -> True+        _ -> False+      parseKindIdV7Text @"req" uppercase `shouldBe` Left IdDomainNonCanonical+      parseKindIdV7Text @"req" nonV7 `shouldSatisfy` \case+        Left IdDomainNotUuidV7 {} -> True+        _ -> False+      parseEither (parseKindIdV7Value @"req") (Aeson.String uppercase)+        `shouldSatisfy` \case+          Left problem -> "not canonical lowercase" `T.isInfixOf` T.pack problem+          Right _ -> False++    it "validates contract TypeID prefixes only at the language-4 boundary" $ do+      let source versionNumber =+            T.unlines+              [ "language keiro-dsl " <> T.pack (show versionNumber),+                "context invalid-contract-prefix",+                "contract emergency {",+                "  schemaVersion 1",+                "  discriminator messageType",+                "  topic incidentEvents \"emergency.incident.events\"",+                "  event IncidentDeclared on incidentEvents {",+                "    incidentId: typeid \"Bad\"",+                "  }",+                "}"+              ]+      v3 <- parseRight "contract-prefix-v3.keiro" (source (3 :: Int))+      v4 <- parseRight "contract-prefix-v4.keiro" (source (4 :: Int))+      validateService (checkedSource v3) `shouldBe` []+      case validateService (checkedSource v4) of+        [diagnostic] -> do+          (.code) diagnostic `shouldBe` ContractInvalidTypeIdPrefix+          (.line) diagnostic `shouldBe` 8+          (.message) diagnostic `shouldSatisfy` T.isInfixOf "contract 'emergency' event 'IncidentDeclared' field 'incidentId'"+          (.message) diagnostic `shouldSatisfy` T.isInfixOf "invalid TypeID prefix 'Bad'"+        diagnostics -> expectationFailure ("expected one invalid contract prefix diagnostic, got " <> show diagnostics)++    it "keeps version-3 and version-4 aggregate fold and replay semantics equal" $ do+      v3Text <- readTestText "test/fixtures/id-domain-migration-v3.keiro"+      v3 <- parseRight "fold-v3.keiro" v3Text+      v4 <- parseRight "fold-v4.keiro" (T.replace "language keiro-dsl 3" "language keiro-dsl 4" v3Text)+      let v3Service = checkedSource v3+          v4Service = checkedSource v4+          fingerprints service =+            [ aggregateFoldFingerprintForService service aggregate+            | NAggregate aggregate <- (.nodes) (checkedSpec service)+            ]+      fingerprints v4Service `shouldBe` fingerprints v3Service+      diffServices v3Service v4Service `shouldBe` []+      resolvedFold (ReplayImpact.replayImpactServices v3Service v4Service) `shouldBe` ReplayNeutral++    it "keeps runtime validation and the exact Keiki text image in agreement" $ do+      let contract = typeIdV7Domain "req"+          sampleText = idDomainSampleText contract+          suffix = T.drop (T.length "req_") sampleText+          replaceAt position replacement value =+            T.take position value <> T.singleton replacement <> T.drop (position + 1) value+          accepted =+            [ sampleText,+              replaceAt (T.length "req_" + 10) 'f' sampleText,+              replaceAt (T.length "req_" + 13) 'v' sampleText+            ]+          rejected =+            [ "",+              "req_",+              "other_" <> suffix,+              "req__" <> suffix,+              T.dropEnd 1 sampleText,+              sampleText <> "0",+              T.toUpper sampleText,+              replaceAt (T.length "req_" + 0) '8' sampleText,+              replaceAt (T.length "req_" + 10) 'd' sampleText,+              replaceAt (T.length "req_" + 13) 'c' sampleText+            ]+          patternValue = either (error . show) id (idDomainTextPattern contract)+      idDomainVersion contract `shouldBe` "keiro-dsl/id-domain/typeid-v7/1"+      idDomainSeparator contract `shouldBe` '_'+      idDomainSuffixLength contract `shouldBe` 26+      idDomainMaxLength contract `shouldBe` T.length sampleText+      forM_ accepted $ \value -> do+        validateIdDomainText contract value `shouldBe` Right ()+        matchesTextPattern patternValue value `shouldBe` True+      forM_ rejected $ \value -> do+        validateIdDomainText contract value `shouldSatisfy` isLeft+        matchesTextPattern patternValue value `shouldBe` False++    it "agrees for generated canonical and malformed domain values" $ property $ do+      let crockford = "0123456789abcdefghjkmnpqrstvwxyz"+          segment count = vectorOf count (elements crockford)+      leading <- elements "01234567"+      beforeVersion <- segment 9+      version <- elements "ef"+      beforeVariant <- segment 2+      variantDigit <- elements "89abrstv"+      afterVariant <- segment 12+      let value = T.pack ("req_" <> [leading] <> beforeVersion <> [version] <> beforeVariant <> [variantDigit] <> afterVariant)+          contract = typeIdV7Domain "req"+          patternValue = either (error . show) id (idDomainTextPattern contract)+          invalidValues = [T.toUpper value, "other_" <> T.drop 4 value, T.dropEnd 1 value, value <> "0"]+      pure $+        conjoin+          ( counterexample (T.unpack value) (validateIdDomainText contract value == Right () && matchesTextPattern patternValue value)+              : [counterexample (T.unpack invalid) (isLeft (validateIdDomainText contract invalid) && not (matchesTextPattern patternValue invalid)) | invalid <- invalidValues]+          )++    it "enforces the same contract before consumer binding conversion and explains its version" $ do+      v2Source <- readTestText "test/fixtures/nominal-scalars.keiro"+      let v3Text = T.replace "language keiro-dsl 2" "language keiro-dsl 3" v2Source+      parsed <- case parseSource "nominal-scalars-v3.keiro" v3Text of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let service = checkedSource parsed+          spec = checkedSpec service+          modules = scaffoldServiceModules (defaultContext (spec.context)) service+          generatedText suffix = case [(.text) value | value <- modules, T.pack suffix `T.isSuffixOf` T.pack ((.path) value)] of+            [value] -> value+            values -> error ("expected one generated module ending in " <> suffix <> ", got " <> show (length values))+          codecModule = generatedText "NominalLedger/Codec.hs"+          projectionModule = generatedText "NominalProjections.hs"+          harnessModule = generatedText "NominalLedger/Harness.hs"+      validateService service `shouldBe` []+      codecModule `shouldSatisfy` T.isInfixOf "case validateIdDomainText (typeIdV7Domain \"ord\") input of"+      codecModule `shouldSatisfy` T.isInfixOf "Right () -> case KindID.parseText @\"ord\" input of"+      projectionModule `shouldSatisfy` T.isInfixOf "idDomainTextPattern (typeIdV7Domain \"ord\")"+      projectionModule `shouldSatisfy` T.isInfixOf "validateIdDomainText (typeIdV7Domain \"ord\") value"+      harnessModule `shouldSatisfy` T.isInfixOf "nominal ID binding preserves canonical representations: OrderId"+      harnessModule `shouldSatisfy` T.isInfixOf "nominal ID boundary rejects wrong-prefix and normalized text: OrderId"+      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligationsForService service)+      let orderIdBindings = [obligation | obligation <- obligations, (.mappedName) obligation == "OrderId", (.kind) obligation == BindingValue]+      map (.idDomainContract) orderIdBindings `shouldBe` [Just "keiro-dsl/id-domain/typeid-v7/1"]+      renderBindingObligations (spec.context) obligations+        `shouldSatisfy` T.isInfixOf "id-domain-contract: \"keiro-dsl/id-domain/typeid-v7/1\""++    it "reports adoption by boundary, invalidates snapshots, and preserves replay compatibility" $ do+      v2Text <- readTestText "test/fixtures/id-domain-migration-v3.keiro"+      let oldText = T.replace "language keiro-dsl 3" "language keiro-dsl 2" v2Text+      oldSource <- case parseSource "id-domain-migration-v2.keiro" oldText of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      newSource <- case parseSource "id-domain-migration-v3.keiro" v2Text of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let oldService = checkedSource oldSource+          newService = checkedSource newSource+          changes = diffSources oldSource newSource+          findings = [kindOfChange change | change <- changes, changeCode change == IdDomainContractChanged]+      length findings `shouldBe` 1+      forM_ findings $ \finding -> do+        verdictFor PrivateHistoryRead (finding.vector) `shouldBe` VCompatible+        verdictFor OldBinaryReadNewEvents (finding.vector) `shouldBe` VCompatible+        verdictFor SnapshotHydration (finding.vector) `shouldBe` VAdvisory+        verdictFor PublicConsumer (finding.vector) `shouldBe` VBreaking+        verdictFor PersistedIdentity (finding.vector) `shouldBe` VCompatible+        verdictFor ConsumerBuild (finding.vector) `shouldBe` VAdvisory+        (.detail) finding `shouldSatisfy` T.isInfixOf "historical event replay retains its legacy decoder"+        remediationFor (finding.context) ((.code) finding)+          `shouldBe` RemedyDeploymentOrder RolloutProducerLast :| [RemedyStateCodecBump, RemedyRecompileConsumers, RemedyRunConformance]+      [(.detail) finding | change <- changes, changeCode change == SourceLanguageDeclarationChanged, let finding = kindOfChange change]+        `shouldSatisfy` all (T.isInfixOf "effective runtime semantics changed")+      idDomainIdentitiesForService oldService `shouldBe` []+      idDomainIdentitiesForService newService+        `shouldSatisfy` any (T.isInfixOf "contract=keiro-dsl/id-domain/typeid-v7/1")+      resolvedFold (ReplayImpact.replayImpactServices oldService newService) `shouldSatisfy` \case+        ReplayImpact.ReplayAffected impacts ->+          maybe False (.includeSnapshotStreams) (Map.lookup "OrderBook" impacts)+        ReplayImpact.ReplayNeutral -> False++    it "keeps the raw constructor outside the compiled public module surface" $+      withTempDirectory "keiro-dsl-id-domain-hidden-constructor" $ \out -> do+        sourceText <- readTestText "test/fixtures/id-domain-migration-v3.keiro"+        parsed <- case parseSource "id-domain-migration-v3.keiro" sourceText of+          Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+          Right value -> pure value+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            modules = scaffoldServiceModules ctx service+            attempt = out </> "Attempt.hs"+            ghcOutput = out </> ".ghc"+        result <- executeServiceScaffold out False "id-domain-migration-v3.keiro" ((.sourceLanguage) parsed) ctx service modules+        result `shouldSatisfy` isRight+        recordContents <- TIO.readFile (out </> recordFileName (spec.context))+        record <- case parseRecord recordContents of+          Nothing -> expectationFailure "generated ID-domain scaffold record did not parse" >> fail "unreachable"+          Just value -> pure value+        (.idDomains) record `shouldBe` idDomainIdentitiesForService service+        (.nominalEqualities) record+          `shouldSatisfy` any (T.isInfixOf "keiro-dsl/id-domain/typeid-v7/1")+        createDirectoryIfMissing True ghcOutput+        TIO.writeFile+          attempt+          ( T.unlines+              [ "module Attempt where",+                "import Generated.IdDomainMigration.Nominals (OrderId (..))",+                "bad :: OrderId",+                "bad = OrderId \"ord_LEGACY-NOT-TYPEID\""+              ]+          )+        keiroCorePackageId <- activeCabalPackageId "keiro-core"+        keikiPackageId <- activeCabalPackageId "keiki"+        (exitCode, standardOutput, standardError) <-+          readProcessWithExitCode+            "cabal"+            [ "exec",+              "--enable-tests",+              "--",+              "ghc",+              "-XGHC2024",+              "-XOverloadedStrings",+              "-fno-code",+              "-fforce-recomp",+              "-package-id",+              keiroCorePackageId,+              "-package-id",+              keikiPackageId,+              "-outputdir",+              ghcOutput,+              "-i" <> out,+              attempt+            ]+            ""+        exitCode `shouldSatisfy` (/= ExitSuccess)+        (standardOutput <> standardError) `shouldContain` "OrderId"++    it "emits one enforced nominal owner for a version-3 workspace" $ do+      manifest <- readTestText "test/fixtures/workspace-nominals/service.keiro-workspace"+      shared <- readTestText "test/fixtures/workspace-nominals/domain/shared.keiro"+      project <- readTestText "test/fixtures/workspace-nominals/domain/project.keiro"+      artifact <- readTestText "test/fixtures/workspace-nominals/domain/project-artifact.keiro"+      let v3 = T.replace "language keiro-dsl 2" "language keiro-dsl 3"+          source =+            memoryContentSource+              ( Map.fromList+                  [ ("service.keiro-workspace", manifest),+                    ("domain/shared.keiro", v3 shared),+                    ("domain/project.keiro", v3 project),+                    ("domain/project-artifact.keiro", v3 artifact)+                  ]+              )+      loaded <- loadWorkspace source "service.keiro-workspace"+      workspace <- case loaded of+        Left failure -> expectationFailure (show failure) >> fail "unreachable"+        Right value -> pure value+      plan <- case planWorkspaceScaffold "goldens" (workspaceContext workspace) workspace of+        Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+        Right value -> pure value+      let paths = map ((.path) . fst) ((.modules) plan)+      length (filter (== "Generated/WorkspaceNominalProof/Nominals.hs") paths) `shouldBe` 1+      length (filter (== "Generated/WorkspaceNominalProof/Nominals/Internal.hs") paths) `shouldBe` 1+      forM_ [(.text) value | (value, _) <- (.modules) plan, "/Domain.hs" `T.isSuffixOf` T.pack ((.path) value)] $ \domainText ->+        domainText `shouldSatisfy` (not . T.isInfixOf "ProjectId (..)")+      withTempDirectory "keiro-dsl-v3-workspace-record" $ \out -> do+        emitted <- executeWorkspaceScaffold out False plan+        emitted `shouldSatisfy` isRight+        recordContents <- TIO.readFile (out </> workspaceRecordFileName ((.service) workspace))+        record <- case parseWorkspaceRecord recordContents of+          Nothing -> expectationFailure "version-3 workspace record did not parse" >> fail "unreachable"+          Just value -> pure value+        (.idDomains) record `shouldBe` idDomainIdentitiesForService (plan.checkedService)+        (.nominalEqualities) record+          `shouldSatisfy` any (T.isInfixOf "keiro-dsl/id-domain/typeid-v7/1")++    it "emits an abstract public ID, an internal legacy seam, and exact equality" $ do+      v2Source <- readTestText "test/fixtures/aggregate-scalar-expressions-v2.keiro"+      let v3Source = T.replace "language keiro-dsl 2" "language keiro-dsl 3" v2Source+      parsed <- case parseSource "aggregate-scalar-expressions-v3.keiro" v3Source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let service = checkedSource parsed+          spec = checkedSpec service+          modules = scaffoldServiceModules (defaultContext (spec.context)) service+          moduleAt path = case [value | value <- modules, value.path == path] of+            [value] -> pure value+            values -> expectationFailure ("expected one module at " <> path <> ", got " <> show (map (.path) values)) >> fail "unreachable"+      validateService service `shouldBe` []+      publicNominals <- moduleAt "Generated/AggregateScalarExpressions/Nominals.hs"+      internalNominals <- moduleAt "Generated/AggregateScalarExpressions/Nominals/Internal.hs"+      domainModule <- moduleAt "Generated/AggregateScalarExpressions/ScalarAccount/Domain.hs"+      codecModule <- moduleAt "Generated/AggregateScalarExpressions/ScalarAccount/Codec.hs"+      transducerModule <- moduleAt "Generated/AggregateScalarExpressions/ScalarAccount/Transducer.hs"+      (.text) publicNominals `shouldSatisfy` T.isInfixOf "parseRequestId"+      (.text) publicNominals `shouldSatisfy` T.isInfixOf "instance ExactFieldProjection RequestIdEqualityProjection"+      (.text) publicNominals `shouldSatisfy` T.isInfixOf "idDomainTextPattern (typeIdV7Domain \"req\")"+      (.text) publicNominals `shouldSatisfy` (not . T.isInfixOf "unsafeRequestIdFromLegacyText")+      (.text) publicNominals `shouldSatisfy` (not . T.isInfixOf "newtype RequestId")+      (.text) internalNominals `shouldSatisfy` T.isInfixOf "newtype RequestId = RequestId Text"+      (.text) internalNominals `shouldSatisfy` T.isInfixOf "unsafeRequestIdFromLegacyText"+      (.text) domainModule `shouldSatisfy` (not . T.isInfixOf "RequestId (..)")+      (.text) codecModule `shouldSatisfy` T.isInfixOf "unsafeRequestIdFromLegacyText <$>"+      (.text) transducerModule `shouldSatisfy` T.isInfixOf "case parseRequestId"+      firewallBreaches modules `shouldBe` []++  describe "scalar expressions" $ do+    it "types required nested nominal paths and preserves nominal guard diagnostics" $ do+      errorCodesOf "test/fixtures/structural-nominal-leaves.keiro" `shouldReturn` []+      errorCodesOf "test/fixtures/nested-nominal-guard-mismatched-id.keiro"+        `shouldReturn` [AggregateGuardTypeMismatch]+      errorCodesOf "test/fixtures/nested-nominal-guard-ordering.keiro"+        `shouldReturn` [AggregateGuardCapabilityUnsupported]+      errorCodesOf "test/fixtures/nested-nominal-guard-optional-path.keiro"+        `shouldReturn` [AggregateExpressionPathUnsupported]+      service <- checkedServiceOf "test/fixtures/structural-nominal-leaves.keiro"+      let spec = checkedSpec service+          transducer = generatedTextEndingIn "TemplateCatalog/Transducer.hs" (scaffoldServiceModules (defaultContext (spec.context)) service)+      transducer `shouldSatisfy` T.isInfixOf "StructuralProjections.templateStateTemplateIdWitness"+      transducer `shouldSatisfy` T.isInfixOf "GeneratedNominals.templateIdEqualityWitness"++    it "parses, validates, and round-trips the authoritative stable scalar fixture" $ do+      source <- readTestText "test/fixtures/aggregate-scalar-expressions-v2.keiro"+      parsed <- case parseSource "aggregate-scalar-expressions-v2.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      validateSpec ((.spec) parsed) `shouldBe` []+      parseSource "round-trip.keiro" (renderSource parsed) `shouldBe` Right parsed+      case [aggregate | NAggregate aggregate <- (.nodes) ((.spec) parsed)] of+        [aggregate] -> case (.transitions) aggregate of+          transition : holeTransition : [] -> do+            (.implementation) transition `shouldBe` GeneratedImplementation+            (.implementation) holeTransition `shouldBe` HoleImplementation+            let environment = expressionEnvironment ((.spec) parsed) aggregate transition+            case lookup "reserved" ((.writes) transition) >>= either (const Nothing) Just . resolveWriteExpr environment "reserved" of+              Just resolved -> do+                (.valueType) resolved `shouldBe` AggregateNatural+                show ((.node) resolved) `shouldContain` "TotalNaturalArithmetic"+              Nothing -> expectationFailure "reserved write did not resolve"+            let service = checkedSource parsed+                modules = scaffoldServiceModules (defaultContext (parsed.spec.context)) service+                transducer = generatedTextEndingIn "Transducer.hs" modules+                holes = holeTextEndingIn "Holes.hs" modules+                surface = aggregateFoldSurfaceForService service aggregate+                manifest = renderManifestForService "aggregate-scalar-expressions-v2.keiro" modules service+                readableTransducer = T.unwords (T.words transducer)+            aggregateFoldFingerprintForService service aggregate `shouldBe` "60f4f059f718b2ee2bca06360ea20221"+            T.lines surface+              `shouldBe` [ "semantic-contract:keiro-dsl/runtime-semantics/2",+                           "state:Open|terminal=false",+                           "state:Reviewed|terminal=false",+                           "state:Closed|terminal=true",+                           "reg:balance:Integer=0",+                           "reg:reserved:Natural=0",+                           "reg:capacity:Natural=5",+                           "reg:machine:Int=0",+                           "reg:label:Text=\"\"",+                           "reg:active:Bool=False",+                           "reg:mode:AccountMode=Normal",+                           "reg:requestId:RequestId=placeholder",+                           "reg:openedAt:Time=(UTCTime (fromGregorian 2026 1 1) (picosecondsToDiffTime 0))",+                           "reg:limits:Limits=initial",+                           "mapped-register:Limits|wire=4463db782a5b9924|canonical=scalar-expressions.Limits.v1|binding=ScalarExpressions.Bindings.limitsBinding|binding-version=1|initial=ScalarExpressions.Bindings.initialLimits",+                           "nominal-equality-use:nominal-equality|name=AccountMode|contract=keiro-dsl/nominal-equality/1|key=Text|domain=finite-text:normal,restricted|owner=generated",+                           "nominal-equality-use:nominal-equality|name=RequestId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:req:keiro-dsl/id-domain/typeid-v7/1|owner=generated",+                           "transition:live|Open|Adjust|implementation=generated|guard=cmd.balance + reg.balance >= -100 && reg.reserved + cmd.requested <= reg.capacity && cmd.observedAt >= reg.openedAt && cmd.limits.minimum >= reg.limits.minimum && cmd.active == false && cmd.mode == reg.mode && cmd.requestId == reg.requestId|writes=balance:=reg.balance + cmd.balance * 2;reserved:=reg.reserved + (cmd.requested - reg.capacity);machine:=-7;label:=\"adjusted\";active:=true;mode:=AccountMode.Restricted;requestId:=RequestId(\"req_01h455vb4pex5vsknk084sn02q\");openedAt:=\"2026-02-03T04:05:06Z\";limits:=cmd.limits|emits=Adjusted|outputs=Adjusted=generated-command-identity:Adjust[balance=balance:Integer,requested=requested:Natural,machine=machine:Int,label=label:Text,active=active:Bool,mode=mode:AccountMode,requestId=requestId:RequestId,observedAt=observedAt:Time,limits=limits:Limits]|goto=Reviewed",+                           "transition:live|Reviewed|Close|implementation=hole|guard=|writes=|emits=ClosedEvent|outputs=ClosedEvent=generated-command-identity:Close[balance=balance:Integer]|goto=Closed"+                         ]+            diffServices service service `shouldBe` []+            resolvedFold (ReplayImpact.replayImpactServices service service) `shouldBe` ReplayNeutral+            manifest `shouldSatisfy` (not . T.isInfixOf "Generated.AggregateScalarExpressions.ScalarAccount.Expressions")+            map (.path) modules `shouldSatisfy` all (not . T.isSuffixOf "Expressions.hs" . T.pack)+            map (.path) modules `shouldSatisfy` any (T.isSuffixOf "Transducer.hs" . T.pack)+            transducer `shouldSatisfy` T.isInfixOf "let commandLimitsMinimum = K.inpProj"+            transducer `shouldSatisfy` T.isInfixOf "registerLimitsMinimum = K.regProj"+            readableTransducer `shouldSatisfy` T.isInfixOf "B.requireGuard $ (((((d.balance .+ B.reg @\"balance\" .>= K.lit (-100 :: Integer) .&& B.reg @\"reserved\" .+ d.requested .<= B.reg @\"capacity\") .&& d.observedAt .>= B.reg @\"openedAt\") .&& commandLimitsMinimum .>= registerLimitsMinimum) .&& d.active .== K.lit False) .&& commandMode .== registerMode) .&& commandRequestId .== registerRequestId"+            transducer `shouldSatisfy` T.isInfixOf "B.slot @\"balance\" =: (B.reg @\"balance\" .+ d.balance .* K.lit (2 :: Integer))"+            transducer `shouldSatisfy` T.isInfixOf "B.slot @\"reserved\" =: (B.reg @\"reserved\" .+ (d.requested .- B.reg @\"capacity\"))"+            transducer `shouldSatisfy` (not . T.isInfixOf "K.PAnd")+            transducer `shouldSatisfy` (not . T.isInfixOf "K.tadd")+            transducer `shouldSatisfy` T.isInfixOf "scalarAccountPredicateVerifications"+            transducer `shouldSatisfy` T.isInfixOf "S.verifyPredicate predicate"+            transducer `shouldSatisfy` T.isInfixOf "B.emit wireAdjusted (AdjustedTermFields"+            transducer `shouldSatisfy` T.isInfixOf "balance = d.balance"+            transducer `shouldSatisfy` (not . T.isInfixOf "transition1OpenAdjustOutput1Adjusted")+            holes `shouldSatisfy` (not . T.isInfixOf "transition1OpenAdjustOutput1Adjusted")+            holes `shouldSatisfy` (not . T.isInfixOf "transition2ReviewedCloseOutput1ClosedEvent")+            holes `shouldSatisfy` T.isInfixOf "transition2ReviewedCloseHoleFoldVersion"+            holes `shouldSatisfy` (not . T.isInfixOf "scalarAccountTransducer")+            firewallBreaches modules `shouldBe` []+          _ -> expectationFailure "expected one generated and one Hole scalar transition"+        _ -> expectationFailure "expected one scalar aggregate"++    it "pins every readable operator, equal-precedence child position, and bare Boolean guard" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context readable-renderer",+                "enum RenderStatus { Ready=ready Waiting=waiting }",+                "aggregate Renderer",+                "  regs",+                "    total Integer = 0",+                "    leftNested Integer = 0",+                "    product Integer = 1",+                "    status RenderStatus = Ready",+                "  states Open Closed!",+                "  command Evaluate { left:Integer right:Integer third:Integer status:RenderStatus }",+                "  event Evaluated = fields(Evaluate)",+                "  Open -- Evaluate -->",+                "    guard ((cmd.left < cmd.right || cmd.left <= cmd.right) || (cmd.left > cmd.right || cmd.left >= cmd.right))",+                "      && (cmd.left == cmd.right && cmd.left != cmd.third)",+                "      && cmd.status == RenderStatus.Waiting",+                "    write total := reg.total + (cmd.left - cmd.right)",+                "    write leftNested := (reg.leftNested + cmd.left) - cmd.right",+                "    write product := cmd.left * (cmd.right * cmd.third)",+                "    write status := RenderStatus.Ready",+                "    emit Evaluated",+                "    goto Closed",+                "aggregate BooleanRenderer",+                "  regs",+                "    enabled Bool = False",+                "  states Open Closed!",+                "  command Enable { enabled:Bool }",+                "  event Enabled = fields(Enable)",+                "  Open -- Enable -->",+                "    guard cmd.enabled",+                "    write enabled := cmd.enabled",+                "    emit Enabled",+                "    goto Closed"+              ]+      spec <- parseInlineSpec "<readable-renderer>" source+      errorCodes spec `shouldBe` []+      let modules = scaffoldModules (defaultContext (spec.context)) spec+          moduleAt suffix = case [(.text) value | value <- modules, T.pack suffix `T.isSuffixOf` T.pack ((.path) value)] of+            [value] -> pure value+            values -> expectationFailure ("expected one generated module ending in " <> suffix <> ", got " <> show (length values)) >> fail "unreachable"+      renderer <- moduleAt "/Renderer/Transducer.hs"+      booleanRenderer <- moduleAt "/BooleanRenderer/Transducer.hs"+      let normalizedRenderer = T.unwords (T.words renderer)+          normalizedBooleanRenderer = T.unwords (T.words booleanRenderer)+      renderer+        `shouldSatisfy` T.isInfixOf "import Keiki.Core (HsPred, SymTransducer, (.*), (.+), (.-), (.==), (./=), (.<), (.<=), (.>), (.>=), (.&&), (.||))"+      normalizedRenderer+        `shouldSatisfy` T.isInfixOf "(d.left .< d.right .|| d.left .<= d.right) .|| d.left .> d.right .|| d.left .>= d.right"+      normalizedRenderer+        `shouldSatisfy` T.isInfixOf ".&& d.left .== d.right .&& d.left ./= d.third"+      normalizedRenderer+        `shouldSatisfy` T.isInfixOf ".&& commandStatus .== K.lit (\"waiting\" :: Text)"+      renderer+        `shouldSatisfy` T.isInfixOf "B.slot @\"total\" =: (B.reg @\"total\" .+ (d.left .- d.right))"+      renderer+        `shouldSatisfy` T.isInfixOf "B.slot @\"leftNested\" =: (B.reg @\"leftNested\" .+ d.left .- d.right)"+      renderer+        `shouldSatisfy` T.isInfixOf "B.slot @\"product\" =: d.left .* (d.right .* d.third)"+      normalizedBooleanRenderer `shouldSatisfy` T.isInfixOf "B.requireGuard $ d.enabled .== K.lit True"+      firewallBreaches modules `shouldBe` []++    it "renders resolved command selectors in scalar and projected expressions" $ do+      source <- readTestText "test/fixtures/aggregate-scalar-expressions-v2.keiro"+      let aliasedSource =+            T.replace "active:Bool" "active haskell commandActive:Bool"+              . T.replace "mode:AccountMode" "mode haskell commandMode:AccountMode"+              . T.replace "requestId:RequestId" "requestId haskell commandRequestId:RequestId"+              . T.replace "limits:Limits" "limits haskell commandLimits:Limits"+              $ source+      service <- checkedServiceFromText "aggregate-scalar-expression-aliases.keiro" aliasedSource+      let spec = checkedSpec service+          transducer = generatedTextEndingIn "Transducer.hs" (scaffoldServiceModules (defaultContext (spec.context)) service)+      validateService service `shouldBe` []+      transducer `shouldSatisfy` T.isInfixOf "d.commandActive"+      transducer `shouldSatisfy` T.isInfixOf "d.commandLimits"+      transducer `shouldSatisfy` T.isInfixOf "(#commandMode :: K.Index"+      transducer `shouldSatisfy` T.isInfixOf "(#commandRequestId :: K.Index"+      transducer `shouldSatisfy` T.isInfixOf "(#commandLimits :: K.Index"+      transducer `shouldSatisfy` (not . T.isInfixOf "d.active")+      transducer `shouldSatisfy` (not . T.isInfixOf "inCtorAdjust (#mode :: K.Index")+      transducer `shouldSatisfy` (not . T.isInfixOf "inCtorAdjust (#requestId :: K.Index")+      transducer `shouldSatisfy` (not . T.isInfixOf "inCtorAdjust (#limits :: K.Index")++    it "suffixes normalized projection-alias collisions deterministically" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context projection-alias-collision",+                "mapped structural record AliasCollision {",+                "  haskell package=keiro-dsl module=Renderer.Domain type=AliasCollision",+                "  binding = \"Renderer.Bindings.aliasCollisionBinding\"",+                "  binding-version = \"1\"",+                "  canonical-type = \"renderer.AliasCollision.v1\"",+                "  fixtures = \"Renderer.Bindings.aliasCollisionCases\"",+                "  initial = \"Renderer.Bindings.initialAliasCollision\"",+                "  wire object constructor=AliasCollision unknown-fields=reject {",+                "    dash as \"foo-bar\" : Integer required",+                "    underscore as \"foo_bar\" : Integer required",+                "  }",+                "}",+                "aggregate AliasRenderer",+                "  regs",+                "    values AliasCollision = initial",+                "  states Open Closed!",+                "  command Compare { values:AliasCollision }",+                "  event Compared = fields(Compare)",+                "  Open -- Compare -->",+                "    guard cmd.values.dash == reg.values.dash",+                "      && cmd.values.underscore == reg.values.underscore",+                "    emit Compared",+                "    goto Closed"+              ]+      spec <- parseInlineSpec "<projection-alias-collision>" source+      errorCodes spec `shouldBe` []+      let transducer = generatedTextEndingIn "Transducer.hs" (scaffoldModules (defaultContext (spec.context)) spec)+      transducer `shouldSatisfy` T.isInfixOf "let commandValuesFooBar = K.inpProj"+      transducer `shouldSatisfy` T.isInfixOf "registerValuesFooBar = K.regProj"+      transducer `shouldSatisfy` T.isInfixOf "commandValuesFooBar2 = K.inpProj"+      transducer `shouldSatisfy` T.isInfixOf "registerValuesFooBar2 = K.regProj"++    it "keeps evolution identity independent of module layout but sensitive to checked behavior" $ do+      source <- readTestText "test/fixtures/aggregate-scalar-expressions-v2.keiro"+      original <- case parseSource "aggregate-scalar-expressions-v2.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      changed <- case parseSource "aggregate-scalar-expressions-changed.keiro" (T.replace "cmd.active == false" "cmd.active == true" source) of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      case ( [aggregate | NAggregate aggregate <- (.nodes) ((.spec) original)],+             [aggregate | NAggregate aggregate <- (.nodes) ((.spec) changed)]+           ) of+        ([originalAggregate], [changedAggregate]) -> do+          let service = checkedSource original+              changedService = checkedSource changed+              prefixed = defaultContext (original.spec.context)+              collocated = prefixed {moduleRoot = "Acme", placement = CollocatedLeaf}+              prefixedModules = scaffoldServiceModules prefixed service+              collocatedModules = scaffoldServiceModules collocated service+              originalSurface = aggregateFoldSurfaceForService service originalAggregate+              originalFingerprint = aggregateFoldFingerprintForService service originalAggregate+          map (.path) prefixedModules `shouldNotBe` map (.path) collocatedModules+          sum (map (T.length . (.text)) prefixedModules) `shouldSatisfy` (> 0)+          sum (map (T.length . (.text)) collocatedModules) `shouldSatisfy` (> 0)+          aggregateFoldSurfaceForService service originalAggregate `shouldBe` originalSurface+          aggregateFoldFingerprintForService service originalAggregate `shouldBe` originalFingerprint+          aggregateFoldSurfaceForService changedService changedAggregate `shouldNotBe` originalSurface+          aggregateFoldFingerprintForService changedService changedAggregate `shouldNotBe` originalFingerprint+        found -> expectationFailure ("expected one aggregate before and after behavior mutation, got " <> show (length (fst found), length (snd found)))++    it "rejects cross-command fields(Command) output before scaffolding" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context output-command-mismatch",+                "aggregate Account",+                "  regs",+                "  states Open Closed!",+                "  command OpenAccount { accountId:Text }",+                "  command CloseAccount { accountId:Text }",+                "  event AccountOpened = fields(OpenAccount)",+                "  Open -- CloseAccount --> emit AccountOpened ; goto Closed"+              ]+      spec <- parseInlineSpec "<output-command-mismatch>" source+      errorCodes spec `shouldContain` [EventOutputCommandMismatch]+      case [aggregate | NAggregate aggregate <- (.nodes) spec] of+        [aggregate] -> case (.transitions) aggregate of+          [transition] ->+            eventOutputMapping spec aggregate transition 1 "AccountOpened"+              `shouldBe` Left (OutputCommandMismatch "OpenAccount" "CloseAccount" "AccountOpened")+          _ -> expectationFailure "expected one transition"+        _ -> expectationFailure "expected one aggregate"++    it "rejects Int arithmetic and mixed numeric operands before scaffolding" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context scalar-errors",+                "aggregate Counter",+                "  regs",+                "    machine Int = 0",+                "    exact Integer = 0",+                "  states Open Closed!",+                "  command Add { machine:Int exact:Integer }",+                "  event Added = fields(Add)",+                "  Open -- Add -->",+                "    guard cmd.machine + 1 >= 0 && cmd.exact == cmd.machine",+                "    emit Added",+                "    goto Closed"+              ]+      spec <- parseInlineSpec "<scalar-errors>" source+      errorCodes spec `shouldContain` [AggregateExpressionOperatorUnsupported, AggregateExpressionOperandTypeMismatch]++    it "rejects nominal type confusion and unqualified enum values at source checking" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context nominal-type-confusion",+                "id OrderId prefix=ord",+                "id UserId prefix=usr",+                "enum OrderStatus { Draft=draft Submitted=submitted }",+                "enum UserStatus { Active=active Disabled=disabled }",+                "aggregate Account",+                "  regs",+                "    orderId OrderId = placeholder",+                "    status OrderStatus = Draft",+                "  states Open Closed!",+                "  command Compare { orderId:OrderId userId:UserId status:OrderStatus userStatus:UserStatus label:Text }",+                "  event Compared = fields(Compare)",+                "  Open -- Compare -->",+                "    guard cmd.orderId == cmd.userId",+                "      && cmd.status == cmd.userStatus",+                "      && cmd.orderId == cmd.label",+                "      && cmd.status == Draft",+                "    emit Compared",+                "    goto Closed"+              ]+      spec <- parseInlineSpec "<nominal-type-confusion>" source+      let diagnostics = validateSpec spec+      length [() | diagnostic <- diagnostics, (.code) diagnostic == AggregateGuardTypeMismatch]+        `shouldBe` 3+      errorCodes spec `shouldContain` [AggregateExpressionRootUnknown]+      T.unlines (map (.message) diagnostics) `shouldSatisfy` T.isInfixOf "qualify"++    it "rejects machine-Int arithmetic at both platform bounds" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context scalar-int-bounds",+                "aggregate Counter",+                "  regs",+                "    machine Int = 0",+                "  states Open Closed!",+                "  command Set { machine:Int }",+                "  event SetEvent = fields(Set)",+                "  Open -- Set -->",+                "    guard cmd.machine + 1 >= " <> T.pack (show (minBound :: Int)),+                "      && cmd.machine - 1 <= " <> T.pack (show (maxBound :: Int)),+                "    emit SetEvent",+                "    goto Closed"+              ]+      spec <- parseInlineSpec "<scalar-int-bounds>" source+      length [() | diagnostic <- validateSpec spec, (.code) diagnostic == AggregateExpressionOperatorUnsupported]+        `shouldBe` 2++    it "rejects predicate-valued Bool writes that Keiki cannot represent as scalar terms" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context scalar-bool-write",+                "aggregate Flag",+                "  regs",+                "    active Bool = False",+                "  states Open Closed!",+                "  command Set { active:Bool }",+                "  event SetEvent = fields(Set)",+                "  Open -- Set -->",+                "    write active := cmd.active == true",+                "    emit SetEvent",+                "    goto Closed"+              ]+      spec <- parseInlineSpec "<scalar-bool-write>" source+      errorCodes spec `shouldContain` [AggregateExpressionOperatorUnsupported]++    it "requires explicit roots for a same-named register and command field" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context scalar-ambiguity",+                "aggregate Counter",+                "  regs",+                "    amount Integer = 0",+                "  states Open Closed!",+                "  command Set { amount:Integer }",+                "  event SetEvent = fields(Set)",+                "  Open -- Set -->",+                "    guard amount == 0",+                "    emit SetEvent",+                "    goto Closed"+              ]+      spec <- parseInlineSpec "<scalar-ambiguity>" source+      errorCodes spec `shouldContain` [AggregateExpressionRootAmbiguous]++    it "enforces exclusive Hole ownership and preserves its canonical spelling" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context scalar-hole",+                "aggregate Counter",+                "  regs",+                "    amount Integer = 0",+                "  states Open Closed!",+                "  command Set { amount:Integer }",+                "  event SetEvent = fields(Set)",+                "  Open -- Set -->",+                "    implementation hole",+                "    guard cmd.amount >= 0",+                "    emit SetEvent",+                "    goto Closed"+              ]+      parsed <- case parseSource "<scalar-hole>" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      errorCodes ((.spec) parsed) `shouldContain` [AggregateTransitionOwnershipConflict]+      renderSource parsed `shouldSatisfy` T.isInfixOf "implementation hole"++    it "generates a stable per-transition Hole boundary and fold token" $ do+      let source =+            T.unlines+              [ "language keiro-dsl 2",+                "context scalar-hole",+                "aggregate Counter",+                "  regs",+                "    amount Integer = 0",+                "  states Open Closed!",+                "  command Set { amount:Integer }",+                "  event SetEvent = fields(Set)",+                "  Open -- Set -->",+                "    implementation hole",+                "    emit SetEvent",+                "    goto Closed"+              ]+      spec <- parseInlineSpec "<scalar-hole-valid>" source+      aggregate <- case [value | NAggregate value <- (.nodes) spec] of+        [value] -> pure value+        _ -> expectationFailure "expected one Hole aggregate" >> fail "unreachable"+      let modules = scaffoldAggregate (defaultContext (spec.context)) spec aggregate+          transducer = generatedTextEndingIn "Transducer.hs" modules+          holes = holeTextEndingIn "Holes.hs" modules+      errorCodes spec `shouldBe` []+      map (.path) modules `shouldSatisfy` all (not . T.isSuffixOf "Expressions.hs" . T.pack)+      transducer `shouldSatisfy` T.isInfixOf "Holes.transition1OpenSetHole d"+      transducer `shouldSatisfy` T.isInfixOf "foldToken Holes.transition1OpenSetHoleFoldVersion"+      holes `shouldSatisfy` T.isInfixOf "transition1OpenSetHole _d = B.requireGuard K.PTop"+      holes `shouldSatisfy` T.isInfixOf "transition1OpenSetHoleFoldVersion = FoldVersion"+      holes `shouldSatisfy` (not . T.isInfixOf "counterTransducer")++    it "pins v1 and collection rejection at their stable boundaries" $ do+      v1Source <- readTestText "test/fixtures/aggregate-scalar-expressions-v1-rejects.keiro"+      case parseSource "v1.keiro" v1Source of+        Left (SourceLanguageFailure diagnostic) -> (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion+        other -> expectationFailure ("expected v1 source-language refusal, got " <> show other)+      collectionSource <- readTestText "test/fixtures/aggregate-collection-expressions-v2-rejects.keiro"+      case parseSource "collections.keiro" collectionSource of+        Left failure -> renderParseFailure failure `shouldSatisfy` T.isInfixOf "CollectionExpressionUnsupported"+        Right _ -> expectationFailure "collection syntax unexpectedly parsed"++    it "keeps arithmetic operands intact when complementing a scalar comparison" $ do+      let left = EAdd noLoc (EPath noLoc CommandRoot ["balance"]) (ELiteral noLoc (LiteralIntegral 2))+          right = ESubtract noLoc (EPath noLoc RegisterRoot ["balance"]) (ELiteral noLoc (LiteralIntegral 3))+          predicate = ECmp OpLt left right+      complementExpr predicate `shouldBe` ECmp OpGe left right+      complementExpr (complementExpr predicate) `shouldBe` predicate++    it "keeps the committed scalar-expression conformance tree fresh" $ do+      modules <- scaffoldFixture "test/fixtures/aggregate-scalar-expressions-v2.keiro"+      forM_ [generatedModule | generatedModule <- modules, (.kind) generatedModule == Generated] $ \generatedModule -> do+        committed <- readTestText ("test/conformance-scalar-expressions/" <> (.path) generatedModule)+        normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) generatedModule)++  describe "behavior obligations" $ do+    describe "record migration byte contracts" $ do+      it "joins every source-stable behavior origin to one exact source position and freezes behavior-obligations JSON bytes" $ do+        source <- readTestText "test/fixtures/behavior-complete.keiro"+        document <- case parseSourceDocument "test/fixtures/behavior-complete.keiro" source of+          Left failure -> expectationFailure (show failure) >> fail "unreachable"+          Right value -> pure value+        let ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = document+            spec = checkedSpec (checkedSource parsedSource)+        requirements <- either (\errors -> expectationFailure (show errors) >> fail "unreachable") pure (Behavior.deriveBehaviorRequirements spec)+        entries <- either (\errors -> expectationFailure (show errors) >> fail "unreachable") pure (BehaviorSource.planBehaviorSourceMap requirements sourceIndex)+        map (.key) entries `shouldBe` map (.key) requirements+        entries `shouldSatisfy` all ((== "test/fixtures/behavior-complete.keiro") . (.file))+        entries `shouldSatisfy` all ((>= 1) . (.line))+        entries `shouldSatisfy` all ((>= 1) . (.column))+        let exactRequirements = BehaviorSource.attachBehaviorSourceLocations entries requirements+            exactJson =+              Behavior.encodeBehaviorObligationsJson+                (Behavior.BehaviorObligationsReport "test/fixtures/behavior-complete.keiro" Nothing exactRequirements)+            exactText =+              Behavior.renderBehaviorObligationsText+                (Behavior.BehaviorObligationsReport "test/fixtures/behavior-complete.keiro" Nothing exactRequirements)+            exactBytes = TextEncoding.encodeUtf8 exactJson+        assertMatchesByteGolden "test/fixtures/record-migration/behavior-obligations.exact.json.golden" exactBytes+        case Aeson.eitherDecodeStrict' exactBytes of+          Left failure -> expectationFailure ("behavior-obligations JSON did not decode: " <> failure)+          Right value -> do+            jsonField "schema" value `shouldBe` Just (Aeson.String "keiro-dsl/behavior-obligations/1")+            case jsonField "requirements" value of+              Just (Aeson.Array encodedRequirements) -> length encodedRequirements `shouldBe` length requirements+              other -> expectationFailure ("expected behavior requirements array, got " <> show other)+        exactJson `shouldSatisfy` T.isInfixOf "\"quality\":\"exact\""+        exactJson `shouldSatisfy` T.isInfixOf "\"column\":"+        exactJson `shouldSatisfy` T.isInfixOf "\"file\":\"test/fixtures/behavior-complete.keiro\""+        exactText `shouldSatisfy` T.isInfixOf "test/fixtures/behavior-complete.keiro:"+        exactText `shouldSatisfy` T.isInfixOf "[location-quality=exact]"+        [(.origin) requirement | requirement <- requirements, (.kind) requirement == Behavior.RequiredRejection]+          `shouldSatisfy` all (\case Behavior.RejectionRequirementOrigin "Journey" _ -> True; _ -> False)++      it "freezes representative single-file scaffold ledger bytes and parses the golden" $ do+        (singleRecord, _) <- representativeRecordMigrationContracts+        let rendered = renderRecord singleRecord+            renderedBytes = TextEncoding.encodeUtf8 rendered+        assertMatchesByteGolden "test/fixtures/record-migration/single-file-scaffold-record.ledger.golden" renderedBytes+        golden <- readTestText "test/fixtures/record-migration/single-file-scaffold-record.ledger.golden"+        parseRecord golden `shouldBe` Just singleRecord++      it "freezes representative workspace scaffold ledger bytes and parses the golden" $ do+        (_, workspaceRecord) <- representativeRecordMigrationContracts+        let rendered = renderWorkspaceRecord workspaceRecord+            renderedBytes = TextEncoding.encodeUtf8 rendered+        assertMatchesByteGolden "test/fixtures/record-migration/workspace-scaffold-record.ledger.golden" renderedBytes+        golden <- readTestText "test/fixtures/record-migration/workspace-scaffold-record.ledger.golden"+        parseWorkspaceRecord golden `shouldBe` Just workspaceRecord++    it "refuses line-only, missing, and duplicate behavior source anchors before writes" $+      withTempDirectory "keiro-dsl-source-anchor-refusal" $ \out -> do+        baselineTree <- treeSnapshot out+        spec <- specOf "test/fixtures/behavior-complete.keiro"+        requirements <- either (\errors -> expectationFailure (show errors) >> fail "unreachable") pure (Behavior.deriveBehaviorRequirements spec)+        compatibility <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (compatibilitySemanticSourceIndex "behavior-complete.keiro" spec)+        let failureCodes result = case result of+              Left failures -> map (.code) failures+              Right _ -> []+        failureCodes (BehaviorSource.planBehaviorSourceMap requirements compatibility)+          `shouldSatisfy` all (== BehaviorSource.BehaviorSourceAnchorInexact)+        failureCodes (BehaviorSource.planBehaviorSourceMap requirements emptySemanticSourceIndex)+          `shouldSatisfy` all (== BehaviorSource.BehaviorSourceAnchorMissing)+        case BehaviorSource.planBehaviorSourceMap requirements emptySemanticSourceIndex of+          Left (failure : _) -> do+            let diagnostics = planningRefusalDiagnostics [BehaviorSourceRefusal [failure]]+            map (.code) diagnostics `shouldBe` [BehaviorSourceAnchorMissing]+            map (.message) diagnostics `shouldSatisfy` all (T.isInfixOf "behavior-v1-")+            map (.message) diagnostics `shouldSatisfy` all (T.isInfixOf "Journey:")+            map (.message) diagnostics `shouldSatisfy` all (T.isInfixOf "subject=Aggregate")+          result -> expectationFailure ("expected missing-anchor diagnostics, got " <> show result)+        case requirements of+          first : _ ->+            failureCodes (BehaviorSource.planBehaviorSourceMap (first : requirements) compatibility)+              `shouldContain` [BehaviorSource.BehaviorSourceAnchorCollision]+          [] -> expectationFailure "behavior fixture unexpectedly has no requirements"+        treeSnapshot out `shouldReturn` baselineTree++    it "plans one exact context source map and removes line-derived contract and witness bytes" $ do+      source <- readTestText "test/fixtures/behavior-complete.keiro"+      document <- case parseSourceDocument "test/fixtures/behavior-complete.keiro" source of+        Left failure -> expectationFailure (show failure) >> fail "unreachable"+        Right value -> pure value+      let ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = document+          service = checkedSource parsedSource+          ctx = defaultContext ((checkedSpec service).context)+      modules <- either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure (planIndexedServiceScaffold sourceIndex ctx service)+      let sourceMaps = [(.text) value | value <- modules, T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack ((.path) value))]+          contracts = [(.text) value | value <- modules, T.isSuffixOf "/BehaviorContract.hs" (T.pack ((.path) value))]+          witnesses = [(.text) value | value <- modules, T.isSuffixOf "/BehaviorHoles.hs" (T.pack ((.path) value))]+      case sourceMaps of+        [sourceMapText] -> sourceMapText `shouldSatisfy` T.isInfixOf "test/fixtures/behavior-complete.keiro"+        values -> expectationFailure ("expected one behavior source map, got " <> show (length values))+      contracts `shouldSatisfy` all (T.isInfixOf ".BehaviorSourceMap qualified as BehaviorSourceMap")+      contracts `shouldSatisfy` all (not . T.isInfixOf "requirementLine")+      contracts `shouldSatisfy` all (not . T.isInfixOf "spec line")+      witnesses `shouldSatisfy` all (not . T.isInfixOf "spec line")+      compatibility <-+        either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure $+          compatibilitySemanticSourceIndex "<semantic-only>" (checkedSpec service)+      requirements <-+        either (\errors -> expectationFailure (show errors) >> fail "unreachable") pure $+          Behavior.deriveBehaviorRequirements (checkedSpec service)+      case BehaviorSource.planBehaviorSourceMap requirements compatibility of+        Left failures ->+          failures `shouldSatisfy` all ((== BehaviorSource.BehaviorSourceAnchorInexact) . (.code))+        Right _ -> expectationFailure "compatibility line-only provenance fabricated exact behavior columns"++    it "omits the context source map when no behavior contract can import it" $ do+      spec <- parseInlineSpec "<no-behavior>" "language keiro-dsl 4\ncontext no-behavior\n"+      modules <- either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure (planTestScaffold (defaultContext "no-behavior") spec)+      map (.path) modules `shouldSatisfy` all (not . T.isSuffixOf "BehaviorSourceMap.hs" . T.pack)+      map (.path) modules `shouldSatisfy` all (not . T.isSuffixOf "BehaviorContract.hs" . T.pack)++    it "uses one source-wide layout and excludes replay-only initial edges from live harness probes" $ do+      spec <-+        parseInlineSpec "<transition-layout>" $+          T.unlines+            [ "language keiro-dsl 4",+              "context transition-layout",+              "aggregate Journey",+              "  regs",+              "  states Empty Active",+              "  command Start { current:Bool }",+              "  command Legacy { current:Bool }",+              "  event Started = fields(Start)",+              "  event LegacyStarted = fields(Legacy)",+              "  Empty -- Start --> guard cmd.current == true ; emit Started ; goto Active",+              "  Active -- Start --> emit Started ; goto Active",+              "  replay-only Empty -- Start --> guard cmd.current == false ; emit Started ; goto Active",+              "  Active -- Legacy --> emit LegacyStarted ; goto Active",+              "  replay-only Empty -- Legacy --> emit LegacyStarted ; goto Active"+            ]+      aggregate <- case [value | NAggregate value <- (.nodes) spec] of+        [value] -> pure value+        _ -> expectationFailure "expected one transition-layout aggregate" >> fail "unreachable"+      let ctx = defaultContext (spec.context)+          modules = scaffoldAggregate ctx spec aggregate <> harnessFor ctx spec aggregate+          transducer = generatedTextEndingIn "Transducer.hs" modules+          harness = generatedTextEndingIn "Harness.hs" modules+          contract = generatedTextEndingIn "BehaviorContract.hs" modules+      T.count "B.from JourneyEmpty do" transducer `shouldBe` 1+      transducer `shouldSatisfy` T.isInfixOf "transition3EmptyStart"+      transducer `shouldSatisfy` T.isInfixOf "transition5EmptyLegacy"+      T.count "acceptStart :: Bool" harness `shouldBe` 1+      harness `shouldSatisfy` (not . T.isInfixOf "acceptLegacy")+      contract `shouldSatisfy` T.isInfixOf "K.EdgeRef JourneyEmpty 1"+      contract `shouldSatisfy` T.isInfixOf "K.EdgeRef JourneyEmpty 2"++    it "refuses duplicate live initial harness helpers with both source locations" $ do+      spec <-+        parseInlineSpec "<initial-helper-collision>" $+          T.unlines+            [ "language keiro-dsl 4",+              "context helper-collision",+              "aggregate Journey",+              "  regs",+              "  states Empty Active",+              "  command Start { current:Bool }",+              "  event Started = fields(Start)",+              "  Empty -- Start --> guard cmd.current == true ; emit Started ; goto Active",+              "  Empty -- Start --> guard cmd.current == false ; emit Started ; goto Active"+            ]+      let collisions = [diagnostic | diagnostic <- validateSpec spec, (.code) diagnostic == GeneratedOccurrenceCollision]+      map (.line) collisions `shouldBe` [9, 9]+      collisions `shouldSatisfy` all (elem (8, "'Start' also normalizes here") . (.relatedLocations))++    it "inventories generated harness sample constants before rendering" $ do+      service <-+        checkedServiceFromText+          "<sample-helper-collision>"+          ( T.unlines+              [ "language keiro-dsl 4",+                "context helper-collision",+                "id ObservedAt prefix=obs",+                "aggregate Journey",+                "  regs",+                "  states Empty",+                "  command Start {",+                "    request:ObservedAt",+                "    observedAt:Time",+                "  }"+              ]+          )+      let collisions = [diagnostic | diagnostic <- validateService service, (.code) diagnostic == GeneratedOccurrenceCollision]+      map (.line) collisions `shouldBe` [9]+      collisions `shouldSatisfy` all (elem (3, "'ObservedAt' also normalizes here") . (.relatedLocations))++    it "inventories every live-reachable cell, guarded edge, terminal rejection, and replay edge" $ do+      spec <- specOf "test/fixtures/behavior-complete.keiro"+      requirements <- either (\errors -> expectationFailure (show errors) >> pure []) pure (Behavior.deriveBehaviorRequirements spec)+      length requirements `shouldBe` 19+      length [() | requirement <- requirements, (.kind) requirement == Behavior.LiveTransition] `shouldBe` 5+      length [() | requirement <- requirements, (.kind) requirement == Behavior.RequiredRejection] `shouldBe` 11+      length [() | requirement <- requirements, (.kind) requirement == Behavior.ReplayTransition] `shouldBe` 3+      [(.source) requirement | requirement <- requirements, (.kind) requirement == Behavior.RequiredRejection]+        `shouldContain` ["Active", "Closed"]+      length [() | requirement <- requirements, (.guardCoverage) requirement == Behavior.GuardTotal] `shouldBe` 3+      length [() | requirement <- requirements, (.guardCoverage) requirement == Behavior.GuardUnknown] `shouldBe` 2+      let report = Behavior.BehaviorObligationsReport "behavior-complete.keiro" Nothing requirements+          encoded = Behavior.encodeBehaviorObligationsJson report+          rendered = Behavior.renderBehaviorObligationsText report+      encoded `shouldSatisfy` T.isInfixOf "\"schema\":\"keiro-dsl/behavior-obligations/1\""+      encoded `shouldSatisfy` T.isInfixOf "\"source\":\"Closed\""+      encoded `shouldSatisfy` T.isInfixOf "\"kind\":\"replay-transition\""+      encoded `shouldSatisfy` T.isInfixOf "\"quality\":\"line-only\""+      rendered `shouldSatisfy` T.isInfixOf "[location-quality=line-only]"+      encoded `shouldSatisfy` (not . T.isInfixOf "\"filled\"")+      encoded `shouldSatisfy` (not . T.isInfixOf "\"missing\"")++    it "keeps semantic keys stable across line movement and canonical pretty printing" $ do+      source <- readTestText "test/fixtures/behavior-complete.keiro"+      parsed <- case parseSource "behavior-complete.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let original = (.spec) parsed+      moved <- parseInlineSpec "behavior-complete-moved.keiro" ("# line movement must not rename witnesses\n\n" <> source)+      pretty <- parseInlineSpec "behavior-complete-pretty.keiro" (renderSource parsed)+      let keys spec = fmap (map (.key)) (Behavior.deriveBehaviorRequirements spec)+      keys moved `shouldBe` keys original+      keys pretty `shouldBe` keys original++    it "generates direct fields(Command) output and separate create-once pending witnesses" $ do+      service <- checkedServiceOf "test/fixtures/behavior-complete.keiro"+      let spec = checkedSpec service+      aggregate <- case [value | NAggregate value <- (.nodes) spec] of+        [value] -> pure value+        _ -> expectationFailure "expected one behavior-complete aggregate" >> fail "unreachable"+      let ctx = defaultContext (spec.context)+          modules = scaffoldAggregate ctx spec aggregate+          harness = generatedTextEndingIn "Harness.hs" (harnessForService ctx service aggregate)+          transducer = generatedTextEndingIn "Transducer.hs" modules+          codec = generatedTextEndingIn "Codec.hs" modules+          contract = generatedTextEndingIn "BehaviorContract.hs" modules+          projection = generatedTextEndingIn "Projection.hs" modules+          behaviorHoles = case [(.text) value | value <- modules, T.isSuffixOf "BehaviorHoles.hs" (T.pack ((.path) value))] of+            [value] -> value+            values -> error ("expected one BehaviorHoles module, got " <> show (length values))+          ordinaryHoles = [value | value <- modules, T.isSuffixOf "/Holes.hs" (T.pack ((.path) value)), not (T.isSuffixOf "BehaviorHoles.hs" (T.pack ((.path) value)))]+      transducer `shouldSatisfy` T.isInfixOf "requestId = d.requestId"+      transducer `shouldSatisfy` T.isInfixOf "observedAt = d.observedAt"+      transducer `shouldSatisfy` T.isInfixOf "amount = d.amount"+      transducer `shouldSatisfy` T.isInfixOf "details = d.details"+      codec `shouldSatisfy` T.isInfixOf "display_label"+      codec `shouldSatisfy` T.isInfixOf "optional_note"+      transducer `shouldSatisfy` (not . T.isInfixOf "Output")+      ordinaryHoles `shouldBe` []+      obsoleteGeneratedOutputHooks spec `shouldContain` [("Journey", "transition1EmptyStartOutput1Started")]+      T.count "B.from JourneyEmpty do" transducer `shouldBe` 1+      transducer `shouldSatisfy` T.isInfixOf "verifyTransition \"transition3EmptyStart\" GeneratedOwned JourneyEmpty 1"+      transducer `shouldSatisfy` T.isInfixOf "verifyTransition \"transition5EmptyLegacyStart\" GeneratedOwned JourneyEmpty 2"+      T.count "acceptStart :: Bool" harness `shouldBe` 1+      harness `shouldSatisfy` (not . T.isInfixOf "acceptLegacyStart")+      contract `shouldSatisfy` T.isInfixOf "keiro/behavior-conformance/1"+      contract `shouldSatisfy` T.isInfixOf "commandKind command == requirement.requirementCommandName"+      contract `shouldSatisfy` (not . T.isInfixOf "OPTIONS_GHC")+      contract `shouldSatisfy` T.isInfixOf "module Generated.BehaviorComplete.Journey.BehaviorContract\n  ( BehaviorKey (..)"+      contract `shouldSatisfy` T.isInfixOf "runRejection :: BehaviorRequirement"+      contract `shouldSatisfy` T.isInfixOf "failureSubject :: !Text"+      contract `shouldSatisfy` T.isInfixOf "\"subject\" .= behaviorFailure.failureSubject"+      contract `shouldSatisfy` T.isInfixOf "-- JourneyEmpty x Start: live transition"+      contract `shouldSatisfy` (not . T.isInfixOf "spec line")+      contract `shouldSatisfy` T.isInfixOf "requirementKey = BehaviorKey \"behavior-v1-"+      contract `shouldSatisfy` T.isInfixOf "requirementCommandName = \"Start\""+      contract `shouldSatisfy` T.isInfixOf "requirementExpectedEdge = (Just (K.EdgeRef JourneyEmpty 1))"+      contract `shouldSatisfy` T.isInfixOf "requirementCommandName = \"LegacyStart\""+      contract `shouldSatisfy` T.isInfixOf "requirementExpectedEdge = (Just (K.EdgeRef JourneyEmpty 2))"+      contract `shouldSatisfy` T.isInfixOf "runtime event values differ from the exact witness expectation; actual="+      T.count "Pending (BehaviorKey " behaviorHoles `shouldBe` 19+      behaviorHoles `shouldSatisfy` T.isInfixOf "-- JourneyEmpty x Start: live transition"+      behaviorHoles `shouldSatisfy` (not . T.isInfixOf "spec line")+      behaviorHoles `shouldSatisfy` (not . T.isInfixOf "undefined")+      behaviorHoles `shouldSatisfy` (not . T.isInfixOf "error")+      T.count "sampleRequestId :: RequestId" harness `shouldBe` 1+      T.count "sampleObservedAt :: UTCTime" harness `shouldBe` 1+      harness `shouldSatisfy` T.isInfixOf "Left problem -> error (show problem)"+      harness `shouldSatisfy` T.isInfixOf "sampleEventStarted = Started (StartedData sampleRequestId sampleObservedAt"+      harness `shouldSatisfy` T.isInfixOf "case step journeyTransducer (JourneyEmpty, initialJourneyRegs) (Start (StartData"+      harness `shouldSatisfy` T.isInfixOf "-- clock-free: spec samples no wall clock (verified at scaffold time)"+      harness `shouldSatisfy` (not . T.isInfixOf "(\"clock-free: spec samples no wall clock\", True)")+      codec `shouldSatisfy` T.isInfixOf "parseOptionalField (pure Nothing) (\\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseJSON) other0) objectValue \"optional_note\""+      T.count "parseOptionalField ::" codec `shouldBe` 1+      projection `shouldSatisfy` T.isInfixOf "-- No projection declarations are present; this module keeps the generated manifest inventory total."++    it "rejects eventless state or register changes while accepting a true no-op" $ do+      invalid <-+        parseInlineSpec "<eventless-change>" $+          T.unlines+            [ "language keiro-dsl 2",+              "context eventless-change",+              "aggregate Counter",+              "  regs",+              "    count Natural = 0",+              "  states Open Closed!",+              "  command Tick { count:Natural }",+              "  Open -- Tick --> write count := cmd.count ; goto Closed"+            ]+      errorCodes invalid `shouldContain` [AggregateEventlessStateChange]+      valid <-+        parseInlineSpec "<eventless-noop>" $+          T.unlines+            [ "language keiro-dsl 2",+              "context eventless-noop",+              "aggregate Counter",+              "  regs",+              "    count Natural = 0",+              "  states Open",+              "  command Tick { count:Natural }",+              "  event Ticked = fields(Tick)",+              "  Open -- Tick --> goto Open"+            ]+      errorCodes valid `shouldBe` []++    it "refuses duplicate semantic behavior identities before scaffolding" $ do+      duplicate <-+        parseInlineSpec "<duplicate-behavior>" $+          T.unlines+            [ "language keiro-dsl 2",+              "context duplicate-behavior",+              "aggregate Counter",+              "  regs",+              "  states Open",+              "  command Tick { amount:Natural }",+              "  event Ticked = fields(Tick)",+              "  Open -- Tick --> emit Ticked ; goto Open",+              "  Open -- Tick --> emit Ticked ; goto Open"+            ]+      let isBehaviorRefusal (BehaviorRefusal _) = True+          isBehaviorRefusal _ = False+      case planTestScaffold (defaultContext (duplicate.context)) duplicate of+        Left refusals -> refusals `shouldSatisfy` any isBehaviorRefusal+        Right _ -> expectationFailure "duplicate behavior identity reached a scaffold write set"++    it "round-trips additive single-file and workspace behavior rows with member ownership" $ do+      spec <- specOf "test/fixtures/behavior-complete.keiro"+      requirements <- either (\errors -> expectationFailure (show errors) >> pure []) pure (Behavior.deriveBehaviorRequirements spec)+      version <- maybe (expectationFailure "language version 2 was not constructible" >> fail "unreachable") pure (languageVersion 2)+      let rows = Behavior.behaviorRecordRows requirements+          singleRecord =+            ScaffoldRecord+              { specPath = "behavior-complete.keiro",+                moduleRoot = "",+                layout = "prefixed",+                sourceLanguage = DeclaredLanguage version noLoc,+                languageContract = effectiveLanguageContract (DeclaredLanguage version noLoc),+                namingEdition = IdiomaticNamingV1,+                moduleRoles = [],+                files = [],+                mappings = [],+                idDomains = [],+                nominalEqualities = [],+                bindingObligations = [],+                behaviorRequirements = rows,+                projectionCatalogFacts = [],+                queryContractBaseline = True,+                queryContracts = [],+                routerSelections = [],+                processReactions = [],+                semanticImpact = Nothing+              }+      T.count "behavior " (renderRecord singleRecord) `shouldBe` 19+      parseRecord (renderRecord singleRecord) `shouldBe` Just singleRecord++      workspace <- shouldComposeWorkspace "test/fixtures/behavior-complete-workspace/service.keiro-workspace"+      workspaceRequirements <- either (\errors -> expectationFailure (show errors) >> pure []) pure (Behavior.deriveBehaviorRequirements ((.mergedSpec) workspace))+      let ownedRequirements =+            map+              (Behavior.attributeBehaviorOwner (fmap fst . nodeOwner ((.ownership) workspace) "aggregate"))+              workspaceRequirements+          ownedRows = Behavior.behaviorRecordRows ownedRequirements+          workspaceRecord =+            WorkspaceRecord+              { service = (.service) workspace,+                manifest = "service.keiro-workspace",+                context = workspace.context,+                moduleRoot = "",+                layout = "prefixed",+                members = map (.path) ((.members) workspace),+                sourceLanguages = [WorkspaceSourceLanguageRow ((.path) member) ((.sourceLanguage) member) | member <- (.members) workspace],+                languageContract = (.languageContract) workspace,+                namingEdition = IdiomaticNamingV1,+                modules = [],+                mappings = [],+                idDomains = [],+                nominalEqualities = [],+                bindingObligations = [],+                requirements = ownedRows,+                projectionCatalogFacts = [],+                queryContractBaseline = True,+                queryContracts = [],+                routerSelections = [],+                adopted = [],+                semanticImpact = Nothing+              }+      map (.owner) ownedRows `shouldSatisfy` all (== Just "journey.keiro")+      T.count "behavior " (renderWorkspaceRecord workspaceRecord) `shouldBe` 19+      parseWorkspaceRecord (renderWorkspaceRecord workspaceRecord) `shouldBe` Just workspaceRecord++    it "keeps the initial replay fixture byte-identical across single, workspace, and repeat scaffolds" $ do+      withTempDirectory "keiro-dsl-initial-replay-layout" $ \base -> do+        let singleOut = base </> "single"+            workspaceOut = base </> "workspace"+            singleSource = "test/fixtures/behavior-complete.keiro"+            workspaceSource = "test/fixtures/behavior-complete-workspace/service.keiro-workspace"+            journeyModules = filter (T.isPrefixOf "Generated/BehaviorComplete/Journey/" . T.pack . fst)+            behaviorContractPath = "Generated/BehaviorComplete/Journey/BehaviorContract.hs"+            withoutBehaviorContract = filter ((/= behaviorContractPath) . fst)+            present = maybe False (const True)+            normalizeRequirementLines =+              T.unlines+                . map+                  ( \sourceLine ->+                      if "requirementLine =" `T.isInfixOf` sourceLine+                        then fst (T.breakOn "=" sourceLine) <> "= <source-line>"+                        else case T.breakOn "(spec line " sourceLine of+                          (prefix, suffix)+                            | T.null suffix -> sourceLine+                            | otherwise -> prefix <> "(spec line <source-line>)"+                  )+                . T.lines+        (singleCode, singleStdout, singleStderr) <- runKeiroDsl ["scaffold", singleSource, "--out", singleOut]+        unless (singleCode == ExitSuccess) (expectationFailure (singleStdout <> singleStderr))+        singleTree <- treeSnapshot singleOut+        (singleRepeatCode, singleRepeatStdout, singleRepeatStderr) <- runKeiroDsl ["scaffold", singleSource, "--out", singleOut]+        unless (singleRepeatCode == ExitSuccess) (expectationFailure (singleRepeatStdout <> singleRepeatStderr))+        treeSnapshot singleOut `shouldReturn` singleTree+        (workspaceCode, workspaceStdout, workspaceStderr) <- runKeiroDsl ["scaffold", workspaceSource, "--out", workspaceOut]+        unless (workspaceCode == ExitSuccess) (expectationFailure (workspaceStdout <> workspaceStderr))+        workspaceTree <- treeSnapshot workspaceOut+        let singleJourney = journeyModules singleTree+            workspaceJourney = journeyModules workspaceTree+        withoutBehaviorContract workspaceJourney `shouldBe` withoutBehaviorContract singleJourney+        case (lookup behaviorContractPath workspaceJourney, lookup behaviorContractPath singleJourney) of+          (Just workspaceContract, Just singleContract) ->+            normalizeRequirementLines workspaceContract `shouldBe` normalizeRequirementLines singleContract+          (workspaceContract, singleContract) ->+            expectationFailure+              ( "expected both generated behavior contracts, got "+                  <> show (present workspaceContract, present singleContract)+              )+        (workspaceRepeatCode, workspaceRepeatStdout, workspaceRepeatStderr) <- runKeiroDsl ["scaffold", workspaceSource, "--out", workspaceOut]+        unless (workspaceRepeatCode == ExitSuccess) (expectationFailure (workspaceRepeatStdout <> workspaceRepeatStderr))+        treeSnapshot workspaceOut `shouldReturn` workspaceTree++  describe "nominal consumer types" $ do+    it "resolves every category through one checked registry and explains exact obligations" $ do+      spec <- specOf "test/fixtures/nominal-scalars.keiro"+      errorCodes spec `shouldBe` []+      registry <- case resolveNominalTypes spec of+        Left errors -> expectationFailure (show errors) >> fail "unreachable"+        Right value -> pure value+      Map.keys (nominalTypes registry)+        `shouldBe` ["AccountNumber", "FeatureFlag", "ObservedAt", "OrderId", "OrderStatus", "RiskScore", "SequenceNumber"]+      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligations spec)+      length obligations `shouldBe` 21+      map (.category) obligations `shouldSatisfy` all (`elem` ["nominal-id", "nominal-enum", "nominal-scalar"])+      length [() | obligation <- obligations, (.equalityContract) obligation /= Nothing] `shouldBe` 2+      renderBindingObligations (spec.context) obligations `shouldSatisfy` T.isInfixOf "equality-contract:"+      let signatures = map (.signature) obligations+      forM_+        [ "orderIdBinding :: NominalBinding NominalConformance.Domain.OrderId (KindID \"ord\")",+          "orderStatusBinding :: NominalBinding NominalConformance.Domain.OrderStatus Generated.NominalScalars.Nominal.Shape.OrderStatus.OrderStatusRepresentation",+          "accountNumberBinding :: NominalBinding NominalConformance.Domain.AccountNumber Text",+          "orderIdFixtures :: NominalFixtureCases NominalConformance.Domain.OrderId",+          "initialAccountNumber :: NominalConformance.Domain.AccountNumber"+        ]+        (`shouldSatisfy` (`elem` signatures))+      map (.canonicalType) obligations `shouldSatisfy` all (/= Nothing)+      let rendered = renderBindingObligations (spec.context) obligations+      rendered `shouldSatisfy` T.isInfixOf "nominal-id type OrderId"+      rendered `shouldSatisfy` T.isInfixOf "canonical-type: \"nominal.OrderId.v1\""+      case obligations of+        firstObligation : _ ->+          (Aeson.eitherDecode (Aeson.encode firstObligation) :: Either String BindingObligation)+            `shouldBe` Right firstObligation+        [] -> expectationFailure "expected nominal binding obligations"++    it "allocates distinct stable diagnostics for incomplete or incompatible nominal declarations" $ do+      missing <- errorCodesOf "test/fixtures/nominal-missing-facts.keiro"+      missing `shouldBe` replicate 5 NominalMissingIngredient+      errorCodesOf "test/fixtures/nominal-bad-qualified.keiro" `shouldReturn` [NominalInvalidQualifiedName]+      errorCodesOf "test/fixtures/nominal-invalid-prefix.keiro" `shouldReturn` replicate 2 NominalInvalidIdPrefix+      errorCodesOf "test/fixtures/nominal-unsupported-representation.keiro" `shouldReturn` [NominalUnsupportedRepresentation]+      errorCodesOf "test/fixtures/nominal-missing-initial.keiro" `shouldReturn` [NominalMissingInitialValue]+      errorCodesOf "test/fixtures/nominal-name-collision.keiro"+        `shouldReturn` [NominalNameCollision, GeneratedOccurrenceCollision, NominalNameCollision]++    it "keeps v1 rejection at the source-language boundary" $ do+      source <- readTestText "test/fixtures/nominal-v1.keiro"+      case parseSource "nominal-v1.keiro" source of+        Left (SourceLanguageFailure diagnostic) -> (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion+        other -> expectationFailure ("expected source-language refusal, got " <> show other)++    it "scaffolds consumer types, checked codecs, enum representation, projections, and deterministic manifests" $ do+      spec <- specOf "test/fixtures/nominal-scalars.keiro"+      let ctx = defaultContext (spec.context)+          modules = scaffoldModules ctx spec+          moduleAt path = case [value | value <- modules, value.path == path] of+            [value] -> pure value+            values -> expectationFailure ("expected one module at " <> path <> ", got " <> show (map (.path) values)) >> fail "unreachable"+      domainModule <- moduleAt "Generated/NominalScalars/NominalLedger/Domain.hs"+      codecModule <- moduleAt "Generated/NominalScalars/NominalLedger/Codec.hs"+      enumModule <- moduleAt "Generated/NominalScalars/Nominal/Shape/OrderStatus.hs"+      projectionModule <- moduleAt "Generated/NominalScalars/NominalProjections.hs"+      bindingModule <- moduleAt "NominalConformance/Bindings.hs"+      map (.path) modules `shouldNotContain` ["NominalScalars/NominalLedger/Holes.hs"]+      (.text) domainModule `shouldSatisfy` T.isInfixOf "import NominalConformance.Domain (AccountNumber, FeatureFlag, ObservedAt, OrderId, OrderStatus, RiskScore, SequenceNumber)"+      (.text) domainModule `shouldSatisfy` T.isInfixOf "orderId :: !OrderId"+      (.text) domainModule `shouldSatisfy` (not . T.isInfixOf "NominalConformance.Domain.OrderId")+      (.text) domainModule `shouldSatisfy` (not . T.isInfixOf "newtype OrderId")+      (.text) domainModule `shouldSatisfy` (not . T.isInfixOf "data OrderStatus =")+      (.text) codecModule `shouldSatisfy` T.isInfixOf "KindID.parseText @\"ord\""+      (.text) codecModule `shouldSatisfy` T.isInfixOf "KindID.toText (nominalToRepresentation"+      (.text) codecModule `shouldSatisfy` T.isInfixOf "nominalFromRepresentation"+      forM_ ["coerce", "unsafe", "read ", "error "] $ \forbidden ->+        (.text) codecModule `shouldSatisfy` (not . T.isInfixOf forbidden)+      (.text) enumModule `shouldSatisfy` T.isInfixOf "data OrderStatusRepresentation = Draft | Submitted"+      (.text) enumModule `shouldSatisfy` (not . T.isInfixOf "NominalConformance")+      (.text) projectionModule `shouldSatisfy` T.isInfixOf "type FieldOwner AccountNumberNominalProjection = AccountNumber"+      (.text) projectionModule `shouldSatisfy` T.isInfixOf "projectFieldValue _ = nominalToRepresentation Bindings.accountNumberBinding"+      (.text) projectionModule `shouldSatisfy` T.isInfixOf "instance ExactFieldProjection OrderIdEqualityProjection"+      (.text) projectionModule `shouldSatisfy` T.isInfixOf "textProjectionDomain orderIdEqualityPattern"+      (.text) projectionModule `shouldSatisfy` T.isInfixOf "instance ExactFieldProjection OrderStatusEqualityProjection"+      (.text) projectionModule `shouldSatisfy` T.isInfixOf "finiteProjectionDomain (\"draft\" :| [\"submitted\"])"+      (.kind) bindingModule `shouldBe` HoleStub+      (.text) bindingModule `shouldSatisfy` T.isInfixOf "import NominalConformance.Domain (AccountNumber, FeatureFlag, ObservedAt, OrderId, OrderStatus, RiskScore, SequenceNumber)"+      (.text) bindingModule `shouldSatisfy` T.isInfixOf "orderIdBinding :: NominalBinding OrderId (KindID \"ord\")"+      (.text) bindingModule `shouldSatisfy` T.isInfixOf "orderStatusBinding :: NominalBinding OrderStatus ShapeOrderStatus.OrderStatusRepresentation"+      firewallBreaches modules `shouldBe` []+      scaffoldModules ctx spec `shouldBe` modules+      manifestDependencies spec `shouldContain` ["mmzk-typeid", "nominal-conformance"]++    it "persists nominal provenance in a separate forward-compatible row kind" $ do+      spec <- specOf "test/fixtures/nominal-scalars.keiro"+      workspace <- shouldComposeWorkspace canonicalWorkspacePath+      let plan = consumerPlan spec+          record =+            ScaffoldRecord+              { specPath = "nominal-scalars.keiro",+                moduleRoot = "",+                layout = "prefixed",+                sourceLanguage = LegacyUnversioned,+                languageContract = effectiveLanguageContract LegacyUnversioned,+                namingEdition = IdiomaticNamingV1,+                moduleRoles = [],+                files = [],+                mappings = (.mappings) plan,+                idDomains = [],+                nominalEqualities = nominalEqualityIdentities spec,+                bindingObligations = [],+                behaviorRequirements = [],+                projectionCatalogFacts = [],+                queryContractBaseline = True,+                queryContracts = [],+                routerSelections = [],+                processReactions = [],+                semanticImpact = Nothing+              }+          encoded = renderRecord record+          workspaceRecord =+            (sampleWorkspaceRecord workspace)+              { WorkspaceRecord.mappings = plan.mappings+              }+          workspaceEncoded = renderWorkspaceRecord workspaceRecord+      (.packages) plan `shouldBe` ["nominal-conformance"]+      length [() | NominalMapping {} <- (.mappings) plan] `shouldBe` 7+      T.count "nominal-mapping " encoded `shouldBe` 7+      T.count "nominal-equality " encoded `shouldBe` 2+      T.count "\nmapping " encoded `shouldBe` 0+      parseRecord encoded `shouldBe` Just record+      T.count "nominal-mapping " workspaceEncoded `shouldBe` 7+      T.count "nominal-equality " workspaceEncoded `shouldSatisfy` (>= 2)+      T.count "\nmapping " workspaceEncoded `shouldBe` 0+      parseWorkspaceRecord workspaceEncoded `shouldBe` Just workspaceRecord++    it "reports bound-ID decoder tightening and makes binding provenance replay-visible" $ do+      current <- specOf "test/fixtures/nominal-scalars.keiro"+      let useGeneratedIdInitial (NAggregate aggregate) =+            NAggregate+              ( aggregateWithRegs+                  [ if register.name == "orderId"+                      then regDeclWithInitial (RegInitBare "placeholder") register+                      else register+                  | register <- aggregate.regs+                  ]+                  aggregate+              )+          useGeneratedIdInitial node = node+          unbound =+            specWithIdsAndNodes+              [idDeclWithBinding Nothing declaration | declaration <- current.ids]+              (map useGeneratedIdInitial current.nodes)+              current+          adoption = diffSpecs unbound current+          decoderFindings = [kindOfChange change | change <- adoption, changeCode change == NominalIdDecoderTightened]+      map (.subject) decoderFindings `shouldContain` ["NominalLedger event NominalsRecorded .orderId"]+      decoderFindings `shouldSatisfy` all ((== VAdvisory) . verdictFor PrivateHistoryRead . (.vector))+      let bumped =+            specWithIds+              [ idDeclWithBinding (fmap (nominalBindingWithVersion (Just "2")) declaration.binding) declaration+              | declaration <- current.ids+              ]+              current+          bindingChanges = diffSpecs current bumped+      map changeCode bindingChanges `shouldContain` [NominalBindingChanged]+      replayImpactSpecs current bumped `shouldSatisfy` \case+        ReplayImpact.ReplayAffected impacts ->+          maybe False (\impact -> Set.member "NominalsRecorded" ((.eventTypes) impact) && (.includeSnapshotStreams) impact) (Map.lookup "NominalLedger" impacts)+        ReplayImpact.ReplayNeutral -> False+      case [aggregate | NAggregate aggregate <- (.nodes) current] of+        aggregate : _ -> do+          aggregateFoldSurface current aggregate `shouldSatisfy` T.isInfixOf "nominal-equality-use:"+          aggregateFoldSurface current aggregate `shouldNotBe` aggregateFoldSurface bumped aggregate+        [] -> expectationFailure "expected nominal aggregate"++  describe "historical codec comparison" $ do+    it "treats object-key order as RFC 8785 parity" $ do+      let historical = object ["z" .= (1 :: Int), "a" .= (2 :: Int)]+          generated = object ["a" .= (2 :: Int), "z" .= (1 :: Int)]+      classifyObservation (EncodeObservation "ordered-object" historical generated)+        `shouldBe` Right JsonParity+    it "classifies an omitted key versus explicit null as version work at that pointer" $ do+      let historical = object []+          generated = object ["description" .= Aeson.Null]+      classifyObservation (EncodeObservation "absent-description" historical generated)+        `shouldBe` Right (RequiresVersionWork (EncodedValueDifference (JsonPointer "/description") historical generated))+    it "classifies generated rejection of a historical value as version work" $+      classifyObservation+        ( DecodeObservation+            "legacy.json"+            (object ["tag" .= ("legacy" :: T.Text)])+            (DecodedShape (object ["tag" .= ("legacy" :: T.Text)]))+            (DecodeFailed "unknown tag")+        )+        `shouldBe` Right (RequiresVersionWork (GeneratedDecodeRejected "unknown tag"))+    it "treats historical-codec rejection as invalid input rather than parity" $+      classifyObservation+        ( DecodeObservation+            "corrupt.json"+            Aeson.Null+            (DecodeFailed "not historical data")+            (DecodeFailed "not generated data")+        )+        `shouldBe` Left (HistoricalCodecRejected "corrupt.json" "not historical data")+    it "reports uncovered union arms separately by corpus origin" $ do+      let canonical = DeclaredBranch HistoricalGolden (JsonPointer "/location") (UnionArm "canonical")+          local = DeclaredBranch HistoricalGolden (JsonPointer "/location") (UnionArm "local_file")+          report = compareReport comparisonProvenance [] [] [canonical, local] [ObservedBranch HistoricalGolden (JsonPointer "/location") (UnionArm "local_file")]+      (.coverageGaps) report+        `shouldBe` [CoverageGap HistoricalGolden (JsonPointer "/location") (UnionArm "canonical")]+      reportSucceeded report `shouldBe` False+    it "derives optional, null, and union-arm observations from a generated branch schema" $ do+      let schema =+            BranchRecord+              [ BranchField "description" True (BranchOptional BranchScalar),+                BranchField "location" False (BranchUnion "tag" "contents" [BranchArm "local" (Just BranchScalar), BranchArm "canonical" Nothing])+              ]+          historical = object ["location" .= object ["tag" .= ("canonical" :: T.Text)]]+      observedBranchesFor HistoricalGolden schema historical+        `shouldBe` [ ObservedBranch HistoricalGolden (JsonPointer "/description") OptionalMissing,+                     ObservedBranch HistoricalGolden (JsonPointer "/location") (UnionArm "canonical")+                   ]+      let declared = declaredBranchesFor HistoricalGolden schema+      forM_+        [ DeclaredBranch HistoricalGolden (JsonPointer "/description") OptionalMissing,+          DeclaredBranch HistoricalGolden (JsonPointer "/description") OptionalPresent,+          DeclaredBranch HistoricalGolden (JsonPointer "/description") ExplicitNull,+          DeclaredBranch HistoricalGolden (JsonPointer "/location") (UnionArm "local"),+          DeclaredBranch HistoricalGolden (JsonPointer "/location") (UnionArm "canonical")+        ]+        (\branch -> declared `shouldContain` [branch])+    it "round-trips the stable machine report" $ do+      let observation = EncodeObservation "parity" (object ["a" .= (1 :: Int)]) (object ["a" .= (1 :: Int)])+          report = compareReport comparisonProvenance [] [observation] [] []+      Aeson.eitherDecode (Aeson.encode report) `shouldBe` Right report+    it "atomically writes and replaces the machine report" $+      withTempDirectory "keiro-dsl-codec-compare" $ \out -> do+        let path = out </> "report.json"+            firstReport = compareReport comparisonProvenance [] [] [] []+            secondReport = compareReport comparisonProvenance [HistoricalGoldenUnreadable "bad.json" "bad JSON"] [] [] []+        writeCompareReportAtomic path firstReport `shouldReturn` Right ()+        Aeson.eitherDecodeFileStrict path `shouldReturn` Right firstReport+        writeCompareReportAtomic path secondReport `shouldReturn` Right ()+        Aeson.eitherDecodeFileStrict path `shouldReturn` Right secondReport++  describe "historical codec comparison scaffold" $ do+    it "emits an opt-in non-production runner without entering the ordinary module registry" $ do+      spec <- specOf "test/fixtures/structural-conformance.keiro"+      let ctx = defaultContext (spec.context)+          planned = codecComparisonModule ctx spec "ArtifactInfo"+          ordinary = scaffoldModules ctx spec+      case planned of+        Left err -> expectationFailure (T.unpack err)+        Right comparisonModule -> do+          (.path) comparisonModule+            `shouldBe` "Generated/StructuralConformance/Structural/CodecCompare/ArtifactInfo.hs"+          (.text) comparisonModule `shouldSatisfy` T.isInfixOf codecComparisonBanner+          (.text) comparisonModule `shouldSatisfy` T.isInfixOf "Generated.StructuralConformance.ArtifactCatalog.Codec qualified as GeneratedCodec"+          (.text) comparisonModule `shouldSatisfy` T.isInfixOf "branchSchema = BranchRecord"+          map (.path) ordinary `shouldNotContain` [(.path) comparisonModule]+    it "refuses opaque selections rather than upgrading their claim" $ do+      spec <- specOf "test/fixtures/structural-conformance.keiro"+      codecComparisonModule (defaultContext (spec.context)) spec "VendorGeometry"+        `shouldSatisfy` either (T.isInfixOf "is opaque") (const False)++  describe "structural/opaque coverage reporting" $ do+    it "counts nominal-only consumer roots as structural and inventories their wire boundaries" $ do+      spec <- specOf "test/fixtures/structural-nominal-leaves.keiro"+      report <- shouldResolveCoverage "structural-nominal-leaves.keiro" spec+      (.workqueuePayloads) ((.summary) report)+        `shouldBe` Coverage.CoverageCounts 2 2 0 0+      (.readModelQueryResults) ((.summary) report)+        `shouldBe` Coverage.CoverageCounts 1 1 0 0+      (.nominalBoundaries) report `shouldSatisfy` ((>= 3) . length)+      map (.path) ((.nominalBoundaries) report)+        `shouldContain` ["workqueue template_work payload .templateId : TemplateId"]+      map (.ownership) ((.nominalBoundaries) report)+        `shouldContain` ["generated", "consumer"]+      map (.kind) ((.nominalBoundaries) report)+        `shouldContain` ["enum"]+      map (.canonicalType) [boundary | boundary <- (.nominalBoundaries) report, (.nominal) boundary == "ClaimId"]+        `shouldSatisfy` all (== Just "conformance.structural-nominals.ClaimId.v1")+      let keyedBoundaries = [boundary | boundary <- (.nominalBoundaries) report, "{key}" `T.isInfixOf` (.path) boundary]+      Set.fromList (map (.nominal) keyedBoundaries) `shouldBe` Set.fromList ["ClaimId", "TemplateId"]+      map (.position) keyedBoundaries `shouldSatisfy` all (== "key")+      map (.position) [boundary | boundary <- (.nominalBoundaries) report, "{key}" `T.isInfixOf` (.path) boundary == False]+        `shouldSatisfy` all (== "value")+    it "reports mapped private-event roots and consumer-json register boundaries without a percentage" $ do+      spec <- specOf "test/fixtures/structural-conformance.keiro"+      report <- shouldResolveCoverage "structural-conformance.keiro" spec+      (.privateEventPayloads) ((.summary) report)+        `shouldBe` Coverage.CoverageCounts 2 1 1 0+      (.snapshotRegisters) ((.summary) report)+        `shouldBe` Coverage.CoverageCounts 2 1 1 0+      map (.mappedType) ((.opaqueBoundaries) report)+        `shouldBe` ["VendorGeometry"]+      map (.encoding) ((.snapshotBoundaries) report)+        `shouldBe` ["consumer-json-cache", "consumer-json-cache"]+      map (.invalidation) ((.snapshotBoundaries) report)+        `shouldBe` ["tracked-by-mapped-wire-fingerprint", "tracked-by-mapped-wire-fingerprint"]+      map (.code) ((.findings) report)+        `shouldBe` [CoverageOpaqueSurface]+      map (.severity) ((.findings) report)+        `shouldBe` [Warning]+      case Aeson.toJSON report of+        Aeson.Object values ->+          forM_ ["spec", "roots", "opaqueBoundaries", "snapshotBoundaries", "unsupportedSurfaces"] $+            \key -> KeyMap.member key values `shouldBe` True+        value -> expectationFailure ("coverage report was not an object: " <> show value)+    it "reports queue structural and Json boundaries as a separate persisted surface" $ do+      source <- mappedConsumerSurfaceSource+      spec <- parseInlineSpec "<mapped-queue-coverage>" source+      report <- shouldResolveCoverage "mapped-queue.keiro" spec+      (.workqueuePayloads) ((.summary) report)+        `shouldBe` Coverage.CoverageCounts 1 1 0 1+      map (.path) [root | root <- (.roots) report, (.surface) root == Coverage.WorkqueuePayload]+        `shouldBe` ["workqueue ArtifactJobs payload .jobData : ArtifactInfo [] optional"]+      map (.path) [boundary | boundary <- (.jsonBoundaries) report, (.surface) boundary == Coverage.WorkqueuePayload]+        `shouldContain` ["workqueue ArtifactJobs payload .jobData : ArtifactInfo [] optional .extra"]+      map (.surface) ((.unsupportedSurfaces) report)+        `shouldNotContain` ["queue-payloads"]+    it "reports a built-in-only queue Json expression without fabricating a mapped declaration" $ do+      source <- mappedConsumerSurfaceSource+      spec <-+        parseInlineSpec+          "<explicit-queue-json-coverage>"+          (T.replace "jobData -> \"payload\" : List (Optional ArtifactInfo)" "jobData -> \"payload\" : Optional Json" source)+      report <- shouldResolveCoverage "explicit-queue-json.keiro" spec+      (.workqueuePayloads) ((.summary) report)+        `shouldBe` Coverage.CoverageCounts 0 0 0 1+      map (.path) [boundary | boundary <- (.jsonBoundaries) report, (.surface) boundary == Coverage.WorkqueuePayload]+        `shouldBe` ["workqueue ArtifactJobs payload .jobData optional"]+    it "reports explicit Json leaves by their complete persisted path" $ do+      spec <- withMetadataJson <$> specOf "test/fixtures/structural-conformance.keiro"+      report <- shouldResolveCoverage "structural-conformance-json.keiro" spec+      (.jsonBoundaries) ((.privateEventPayloads) ((.summary) report))+        `shouldBe` 1+      map (.path) ((.jsonBoundaries) report)+        `shouldBe` ["ArtifactCatalog event ArtifactRecorded .artifact : ArtifactInfo .metadata : ArtifactMetadata .note"]+    it "keeps a zero-opaque spec advisory-free and makes rejection explicitly opt-in" $ do+      original <- specOf "test/fixtures/structural-conformance.keiro"+      clear <- shouldResolveCoverage "structural-only.keiro" (withoutVendorGeometry original)+      (.opaqueRoots) ((.privateEventPayloads) ((.summary) clear)) `shouldBe` 0+      (.opaqueBoundaries) clear `shouldBe` []+      (.findings) clear `shouldBe` []+      opaque <- shouldResolveCoverage "structural-conformance.keiro" original+      Coverage.coverageSucceeded opaque `shouldBe` True+      let gated = Coverage.failOnOpaque opaque+      Coverage.coverageSucceeded gated `shouldBe` False+      map (.code) ((.findings) gated)+        `shouldBe` [CoverageOpaqueSurface, CoverageOpaqueGateExceeded]+      map (.severity) ((.findings) gated)+        `shouldBe` [Warning, Error]+    it "diffs named opaque boundaries and fails only an explicitly gated increase" $ do+      newSpec <- specOf "test/fixtures/structural-conformance.keiro"+      report <- case Coverage.coverageDiffReport "structural-conformance.keiro" "HEAD" (withoutVendorGeometry newSpec) newSpec of+        Left err -> expectationFailure (show err) >> fail "unreachable"+        Right value -> pure value+      fmap (.opaqueBoundaryDelta) ((.delta) report) `shouldBe` Just 1+      fmap (map (.mappedType) . (.addedOpaqueBoundaries)) ((.delta) report)+        `shouldBe` Just ["VendorGeometry"]+      map (.code) ((.findings) report)+        `shouldBe` [CoverageOpaqueSurface, CoverageOpaqueBoundaryAdded]+      Coverage.coverageSucceeded report `shouldBe` True+      let gated = Coverage.failOnOpaqueIncrease report+      Coverage.coverageSucceeded gated `shouldBe` False+      map (.code) ((.findings) gated)+        `shouldBe` [CoverageOpaqueSurface, CoverageOpaqueBoundaryAdded, CoverageOpaqueGateExceeded]+    it "appends the six stable coverage and comparison registry codes" $+      map+        show+        [ CoverageOpaqueSurface,+          CoverageOpaqueBoundaryAdded,+          CoverageOpaqueGateExceeded,+          CodecCompareDifference,+          CodecCompareCoverageGap,+          CodecCompareInvalidInput+        ]+        `shouldBe` [ "CoverageOpaqueSurface",+                     "CoverageOpaqueBoundaryAdded",+                     "CoverageOpaqueGateExceeded",+                     "CodecCompareDifference",+                     "CodecCompareCoverageGap",+                     "CodecCompareInvalidInput"+                   ]++  describe "parse . pretty round-trip" $+    do+      it "re-parses any generated spec to an equal AST (modulo source locations)" $+        checkCoverage $+          forAll genSpec $ \s ->+            let families = map nodeTag ((.nodes) s)+                roundTrip = parseSpec "<gen>" (renderSpec s) === Right s+             in cover 5 (not (null ((.mapped) s))) "mapped" $+                  foldr (\family -> cover 1 (family `elem` families) family) roundTrip allNodeTags+      it "round-trips an aggregate with no states" $+        parseSpec "<empty-states>" (renderSpec emptyStatesSpec) `shouldBe` Right emptyStatesSpec+      it "separates transition emit clauses from following nodes" $ do+        spec <- parseInlineSpec "<cross-family-boundaries>" crossFamilyBoundarySpec+        case (.nodes) spec of+          [NAggregate first, NEmit _, NAggregate second, NPgmqDispatch _] -> do+            concatMap (.emits) ((.transitions) first) `shouldBe` ["Changed"]+            (.states) second `shouldBe` []+          nodes -> expectationFailure ("unexpected node sequence: " <> show (map nodeTag nodes))++  describe "mapped types (EP-149)" $ do+    it "round-trips the canonical structural and opaque consumer fixture" $ do+      source <- TIO.readFile "test/fixtures/consumer-types.keiro"+      spec <- parseInlineSpec "test/fixtures/consumer-types.keiro" source+      parseStableRenderedSpec "<consumer-types-round-trip>" spec `shouldBe` Right spec+      length ((.mapped) spec) `shouldBe` 4+    it "round-trips and emits nominal leaves at every structural consumer root" $ do+      source <- TIO.readFile "test/fixtures/mapped-nominal-leaf.keiro"+      parsed <- checkedServiceFromText "test/fixtures/mapped-nominal-leaf.keiro" source+      case parseSource "<mapped-nominal-leaf-round-trip>" ("language keiro-dsl 6\n" <> renderSpec (checkedSpec parsed)) of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right reparsed -> reparsed.spec `shouldBe` checkedSpec parsed+      errorCodesOf "test/fixtures/mapped-nominal-leaf.keiro" `shouldReturn` []+      graph <- shouldResolveTypeGraph (checkedSpec parsed)+      let paths = map renderUsePath (nominalUsePaths graph "TemplateId")+      forM_+        [ "Template command RecordTemplate .state : TemplateState .templateId : TemplateId",+          "workqueue template_work payload .templateId : TemplateId optional",+          "readmodel template_lookup query result : TemplateId []"+        ]+        (\path -> paths `shouldContain` [path])+      (exitCode, emitted, err) <- runKeiroDsl ["check", "test/fixtures/mapped-nominal-leaf.keiro", "--emit"]+      unless (exitCode == ExitSuccess) (expectationFailure (emitted <> err))+      parseSource "<mapped-nominal-leaf-emitted>" (T.pack emitted) `shouldSatisfy` isRight+    it "preserves every missing-value policy, nested type expression, and unit union arm" $ do+      source <- TIO.readFile "test/fixtures/consumer-types.keiro"+      spec <- parseInlineSpec "test/fixtures/consumer-types.keiro" source+      let fields = [field | MappedStructural {msShape = ShapeRecord _ _ recordFields} <- (.mapped) spec, field <- recordFields]+          arms = [arm | MappedStructural {msShape = ShapeUnion _ unionArms} <- (.mapped) spec, arm <- unionArms]+      [value | field <- fields, Just value <- [(.onMissing) field]]+        `shouldBe` [OmCtor "Guide", OmNull, OmInt 0, OmBool False, OmEmptyList, OmEmptyMap]+      [(.valueType) field | field <- fields, (.haskell) field == "labels"]+        `shouldBe` [TList (TOptional TText)]+      [(.ctor) arm | arm <- arms, (.payload) arm == Nothing]+        `shouldBe` ["Unknown"]+    it "round-trips explicit ID-keyed maps without changing legacy Map parsing" $ do+      source <- readTestText "test/fixtures/structural-nominal-leaves.keiro"+      parsed <- checkedServiceFromText "test/fixtures/structural-nominal-leaves.keiro" source+      let spec = checkedSpec parsed+          templateBookFields =+            [ field+            | MappedStructural {msName = "TemplateBook", msShape = ShapeRecord _ _ fields} <- (.mapped) spec,+              field <- fields+            ]+          fieldType fieldName = [(.valueType) field | field <- templateBookFields, (.haskell) field == fieldName]+          rendered = renderSpec spec+      fieldType "byKey" `shouldBe` [TMap (TRef "TemplateId")]+      fieldType "byTemplate" `shouldBe` [TKeyedMap "TemplateId" TText]+      fieldType "claims" `shouldBe` [TKeyedMap "ClaimId" (TRef "TemplateState")]+      rendered `shouldSatisfy` T.isInfixOf "byTemplate as \"by_template\" : Map[TemplateId] Text required"+      rendered `shouldSatisfy` T.isInfixOf "claims as \"claims\" : Map[ClaimId] TemplateState optional on-missing={}"+      case parseSource "<keyed-map-round-trip>" ("language keiro-dsl 6\n" <> rendered) of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right reparsed -> reparsed.spec `shouldBe` spec+    it "reports keyed-map key changes and explains consumer ordering obligations" $ do+      base <- checkedServiceOf "test/fixtures/structural-nominal-leaves.keiro"+      let spec = checkedSpec base+          changeKey declaration@MappedStructural {msName = "TemplateBook", msShape = ShapeRecord constructor unknown fields} =+            declaration+              { msShape =+                  ShapeRecord+                    constructor+                    unknown+                    [ if (.haskell) field == "claims"+                        then field {valueType = TKeyedMap "TemplateId" (TRef "TemplateState")}+                        else field+                    | field <- fields+                    ]+              }+          changeKey declaration = declaration+          changed = spec {mapped = map changeKey ((.mapped) spec)}+          findings = diffMapped spec changed+      map (.code) findings `shouldContain` [MappedFieldTypeChanged]+      map (.leaf) findings `shouldContain` [".field claims[\"claims\"].type"]+      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligationsForService base)+      renderBindingObligations (spec.context) obligations+        `shouldSatisfy` T.isInfixOf "ordering-contract: Ord ClaimId must agree with canonical TypeID text order"+    it "rejects every mapped validation fixture with its stable diagnostic code" $ do+      let cases =+            [ ("mapped-unresolved.keiro", MappedUnresolvedName),+              ("mapped-ambiguous.keiro", MappedAmbiguousName),+              ("mapped-dup-fieldname.keiro", MappedDuplicateFieldName),+              ("mapped-dup-wirekey.keiro", MappedDuplicateWireKey),+              ("mapped-dup-armname.keiro", MappedDuplicateArmName),+              ("mapped-dup-tag.keiro", MappedDuplicateWireTag),+              ("mapped-recursive.keiro", MappedRecursiveType),+              ("mapped-recursive-mutual.keiro", MappedRecursiveType),+              ("mapped-bad-encoding.keiro", MappedUnsupportedEncoding),+              ("mapped-union-key-collision.keiro", MappedUnsupportedEncoding),+              ("mapped-optional-json.keiro", MappedNonInjectiveNullability),+              ("mapped-optional-optional.keiro", MappedNonInjectiveNullability),+              ("mapped-optional-opaque.keiro", MappedNonInjectiveNullability),+              ("mapped-missing-binding.keiro", MappedMissingIngredient),+              ("mapped-missing-binding-version.keiro", MappedMissingIngredient),+              ("mapped-missing-canonical.keiro", MappedMissingIngredient),+              ("mapped-missing-fixture.keiro", MappedMissingIngredient),+              ("mapped-missing-initial.keiro", MappedMissingInitialValue),+              ("mapped-bad-haskell-name.keiro", MappedInvalidHaskellName),+              ("mapped-empty-identity.keiro", MappedInvalidIdentity),+              ("mapped-import-conflict.keiro", MappedImportConflict),+              ("mapped-illtyped-default.keiro", MappedDefaultIllTyped),+              ("mapped-nominal-leaf-language.keiro", MappedNominalLeafRequiresLanguage),+              ("mapped-nominal-leaf-enum-language.keiro", MappedNominalLeafRequiresLanguage),+              ("mapped-nominal-leaf-default.keiro", MappedDefaultIllTyped),+              ("mapped-nominal-queue-only-language.keiro", MappedNominalLeafRequiresLanguage),+              ("mapped-keyed-map-enum-key.keiro", MappedNominalLeafUnsupported),+              ("mapped-guard.keiro", AggregateExpressionOperatorUnsupported)+            ]+      forM_ cases $ \(fixture, expected) ->+        errorCodesOf ("test/fixtures/" <> fixture) `shouldReturn` [expected]+      errorCodesOf "test/fixtures/mapped-nominal-query-only-language.keiro"+        `shouldReturn` replicate 2 MappedNominalLeafRequiresLanguage+      errorCodesOf "test/fixtures/mapped-nominal-leaf-enum.keiro" `shouldReturn` []+      errorCodesOf "test/fixtures/mapped-nominal-queue-only-enum.keiro" `shouldReturn` []+      errorCodesOf "test/fixtures/mapped-nominal-query-only-enum.keiro" `shouldReturn` []+      errorCodesOf "test/fixtures/mapped-nominal-queue-only.keiro" `shouldReturn` []+      errorCodesOf "test/fixtures/mapped-nominal-query-only.keiro" `shouldReturn` []+      language5Source <- readTestText "test/fixtures/mapped-keyed-map-language5.keiro"+      case parseSource "test/fixtures/mapped-keyed-map-language5.keiro" language5Source of+        Left (SourceLanguageFailure diagnostic) -> (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion+        result -> expectationFailure ("expected keyed-map language refusal, got " <> show result)+    it "keeps Time and Natural in Keiki's curated comparison set" $ do+      errorCodesOf "test/fixtures/mapped-guard-time.keiro" `shouldReturn` []+      errorCodesOf "test/fixtures/mapped-guard-natural.keiro" `shouldReturn` []+    it "rejects required defaults, missing optional policies, Int overflow, and negative Natural defaults" $ do+      let invalidFields =+            [ WireField "requiredDefault" "requiredDefault" TText PRequired (Just (OmText "x")) noLoc,+              WireField "missingPolicy" "missingPolicy" TText POptional Nothing noLoc,+              WireField "overflow" "overflow" TInt POptional (Just (OmInt (toInteger (maxBound :: Int) + 1))) noLoc,+              WireField "negativeNatural" "negativeNatural" TNatural POptional (Just (OmInt (-1))) noLoc+            ]+          declaration = completeStructural "Defaults" (ShapeRecord "Defaults" RejectUnknown invalidFields)+      errorCodes (mappedSpec [declaration])+        `shouldBe` [MappedDefaultIllTyped, MappedMissingIngredient, MappedDefaultIllTyped, MappedDefaultIllTyped]++  describe "aggregate type capabilities" $ do+    it "enumerates the policy for every resolved type and use site" $ do+      let resolvedTypes =+            [ AggregateText,+              AggregateInt,+              AggregateBool,+              AggregateTime,+              AggregateNatural,+              AggregateNominal (ResolvedNominalType "EntityId" (IdRepresentation "ent") GeneratedNominal noLoc),+              AggregateNominal (ResolvedNominalType "Status" (EnumRepresentation (("Active", "active") :| [])) GeneratedNominal noLoc),+              AggregateNominal (ResolvedNominalType "Amount" (ScalarRepresentation NominalInt) (consumerNominalFor "Amount") noLoc),+              AggregateNominal (ResolvedNominalType "Label" (ScalarRepresentation NominalText) (consumerNominalFor "Label") noLoc),+              AggregateVertex "EntityVertex",+              AggregateMapped (MappedKey "ConsumerValue")+            ]+          useSites = [minBound .. maxBound]+          expected useSite resolvedType = case useSite of+            OrderingGuardUse -> case resolvedType of+              AggregateInt -> SolverVisible+              AggregateTime -> SolverVisible+              AggregateNatural -> SolverVisible+              AggregateNominal nominal -> case (.representation) nominal of+                ScalarRepresentation NominalInt -> SolverVisible+                ScalarRepresentation NominalNatural -> SolverVisible+                ScalarRepresentation NominalTime -> SolverVisible+                _ -> Unsupported+              _ -> Unsupported+            EqualityGuardUse -> case resolvedType of+              AggregateMapped {} -> Unsupported+              AggregateNominal {} -> SolverVisible+              AggregateVertex {} -> OpaqueOnly+              _ -> SolverVisible+            _ -> case resolvedType of+              AggregateNominal nominal -> case (.representation) nominal of+                ScalarRepresentation {} -> SolverVisible+                _ -> OpaqueOnly+              AggregateVertex {} -> OpaqueOnly+              AggregateMapped {} -> OpaqueOnly+              _ -> SolverVisible+          actual =+            [ (useSite, resolvedType, aggregateCapability useSite resolvedType)+            | useSite <- useSites,+              resolvedType <- resolvedTypes+            ]+          wanted =+            [ (useSite, resolvedType, expected useSite resolvedType)+            | useSite <- useSites,+              resolvedType <- resolvedTypes+            ]+      actual `shouldBe` wanted+    it "lowers direct Time and Natural through every generated aggregate boundary" $ do+      spec <- specOf "test/fixtures/aggregate-scalars.keiro"+      errorCodes spec `shouldBe` []+      let aggregate = onlyAggregate spec+          modules = scaffoldAggregate (defaultContext (spec.context)) spec aggregate+          generated =+            [ (.text) generatedModule+            | generatedModule <- modules,+              (.kind) generatedModule == Generated+            ]+          domain = generatedTextEndingIn "Domain.hs" modules+          codec = generatedTextEndingIn "Codec.hs" modules+      domain `shouldSatisfy` T.isInfixOf "observedAt :: !UTCTime"+      domain `shouldSatisfy` T.isInfixOf "revision :: !Natural"+      domain `shouldSatisfy` T.isInfixOf "UTCTime (fromGregorian 2026 1 2) (picosecondsToDiffTime 11045123456789012)"+      domain `shouldSatisfy` T.isInfixOf "import Data.Time.Calendar (fromGregorian)"+      domain `shouldSatisfy` T.isInfixOf "import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)"+      domain `shouldSatisfy` T.isInfixOf "import Numeric.Natural (Natural)"+      manifestDependencies spec `shouldContain` ["time"]+      manifestDependencies spec `shouldNotContain` ["keiki-codec-json"]+      codec `shouldSatisfy` T.isInfixOf "scalarLedgerEventTypes :: NonEmpty EventType"+      codec `shouldSatisfy` T.isInfixOf "eventTypes = scalarLedgerEventTypes"+      codec `shouldSatisfy` T.isInfixOf "renderExpectedEventTypes scalarLedgerEventTypes"+      codec `shouldSatisfy` (not . T.isInfixOf "; expected one of: ScalarsRecorded\"")+      generated `shouldSatisfy` all (not . T.isInfixOf "error")+      generated `shouldSatisfy` all (not . T.isInfixOf "getCurrentTime")+      generated `shouldSatisfy` all (not . T.isInfixOf "iso8601ParseM")+    it "keeps the event-list binding disjoint from the private formatter" $ do+      source <- readTestText "test/fixtures/aggregate-scalars.keiro"+      spec <- parseInlineSpec "<render-aggregate>" (T.replace "aggregate ScalarLedger" "aggregate Render" source)+      let aggregate = onlyAggregate spec+          modules = scaffoldAggregate (defaultContext (spec.context)) spec aggregate+          codec = generatedTextEndingIn "Codec.hs" modules+          codecLines = T.lines codec+      codecLines `shouldContain` ["renderEventTypes :: NonEmpty EventType"]+      codecLines `shouldContain` ["renderExpectedEventTypes :: NonEmpty EventType -> String"]+      codec `shouldSatisfy` T.isInfixOf "eventTypes = renderEventTypes"+      codec `shouldSatisfy` T.isInfixOf "renderExpectedEventTypes renderEventTypes"+    it "canonicalizes Time and UTCTime across pretty, diff, and fold identity" $ do+      source <- readTestText "test/fixtures/aggregate-scalars.keiro"+      canonical <- parseInlineSpec "<time>" source+      alias <- parseInlineSpec "<utctime>" (T.replace ":Time" ":UTCTime" (T.replace " Time =" " UTCTime =" source))+      renderSpec alias `shouldBe` renderSpec canonical+      legacyDiffSpecs canonical alias `shouldBe` []+      legacyAggregateFoldFingerprint canonical (onlyAggregate canonical)+        `shouldBe` legacyAggregateFoldFingerprint alias (onlyAggregate alias)+      legacyAggregateFoldSurface canonical (onlyAggregate canonical)+        `shouldBe` legacyAggregateFoldSurface alias (onlyAggregate alias)+    it "keeps the committed scalar conformance generated tree fresh" $ do+      modules <- scaffoldFixture "test/fixtures/aggregate-scalars.keiro"+      forM_ [generatedModule | generatedModule <- modules, (.kind) generatedModule == Generated] $ \generatedModule -> do+        committed <- readTestText ("test/conformance-aggregate-scalars/" <> (.path) generatedModule)+        normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) generatedModule)+    it "never sends a clean scalar aggregate to a type scaffold refusal" $+      property $+        forAll (elements scalarRegisterCases) $ \(typeName, initialValue) ->+          case parseSpec "<clean-scalar>" (cleanScalarAggregateSpec typeName initialValue) of+            Left parseError -> counterexample (T.unpack parseError) False+            Right spec ->+              let diagnostics = [diagnostic | diagnostic <- validateSpec spec, (.severity) diagnostic == Error]+                  modules = scaffoldModules (defaultContext (spec.context)) spec+               in counterexample+                    (show diagnostics <> "\n" <> show (scaffoldRefusals spec))+                    ( null diagnostics+                        && null (scaffoldRefusals spec)+                        && all (not . T.null . (.text)) modules+                    )++  describe "aggregate scalar diagnostics" $ do+    it "guides direct optional identifiers to a one-field structural wrapper" $ do+      diagnostics <- diagnosticsOf "test/fixtures/direct-optional-id.keiro"+      let errors = [diagnostic | diagnostic <- diagnostics, (.severity) diagnostic == Error]+      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- errors]+        `shouldBe` [(AggregateTypeUnsupportedAtUse, 9)]+      map (.message) errors+        `shouldBe` ["direct aggregate type 'Optional(TemplateId)' is unsupported at command field; declare `mapped structural record TemplateIdRef { templateId as \"templateId\" : Optional TemplateId optional on-missing=null }` and use it as the field type (candidate Language 6)"]+    it "reports unsupported shapes, invalid initials, and mismatched guards at stable lines" $ do+      diagnostics <- diagnosticsOf "test/fixtures/aggregate-scalars-unsupported.keiro"+      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- diagnostics, (.severity) diagnostic == Error]+        `shouldBe` [ (AggregateRegisterInitialInvalid, 6),+                     (AggregateRegisterInitialInvalid, 7),+                     (AggregateTypeUnsupportedAtUse, 10),+                     (AggregateExpressionOperandTypeMismatch, 14)+                   ]+      map (.message) diagnostics `shouldSatisfy` any (T.isInfixOf "non-negative integral literals")+      map (.message) diagnostics `shouldSatisfy` any (T.isInfixOf "ISO-8601 UTC timestamps")+      map (.message) diagnostics `shouldSatisfy` any (T.isInfixOf "mapped structural declaration")+    it "accepts Natural aggregate arithmetic in the stable language" $ do+      diagnostics <- diagnosticsOf "test/fixtures/aggregate-scalars-arithmetic.keiro"+      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- diagnostics, (.severity) diagnostic == Error]+        `shouldBe` []+    it "covers unknown, container, fractional, out-of-range, and ordering failures" $ do+      diagnostics <- diagnosticsOf "test/fixtures/aggregate-scalars-invalid-capabilities.keiro"+      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- diagnostics, (.severity) diagnostic == Error]+        `shouldBe` [ (AggregateRegisterInitialInvalid, 6),+                     (AggregateRegisterInitialInvalid, 7),+                     (AggregateTypeUnknown, 10),+                     (AggregateTypeUnsupportedAtUse, 10),+                     (AggregateTypeUnsupportedAtUse, 10),+                     (AggregateTypeUnsupportedAtUse, 10),+                     (AggregateExpressionOperatorUnsupported, 13)+                   ]+    it "keeps one-member workspace diagnostics identical to the single file" $ do+      direct <- diagnosticsOf "test/fixtures/aggregate-scalars-unsupported.keiro"+      composed <- shouldComposeWorkspace "test/fixtures/aggregate-scalars-workspace/service.keiro-workspace"+      let directErrors =+            [((.code) diagnostic, (.line) diagnostic, (.message) diagnostic) | diagnostic <- direct, (.severity) diagnostic == Error]+          workspaceErrors =+            [ ((.code) diagnostic, (.line) (NE.head ((.locations) diagnostic)), (.message) diagnostic)+            | diagnostic <- checkWorkspace composed,+              (.severity) diagnostic == Error+            ]+      workspaceErrors `shouldBe` directErrors++  describe "mapped type graph (EP-149)" $ do+    it "resolves checked declarations, transitive reachability, and every aggregate root path" $ do+      source <- TIO.readFile "test/fixtures/consumer-types.keiro"+      spec <- parseInlineSpec "test/fixtures/consumer-types.keiro" source+      graph <- shouldResolveTypeGraph spec+      Map.size ((.declarations) graph) `shouldBe` 4+      Map.lookup (MappedKey "ArtifactInfo") ((.reachability) graph)+        `shouldBe` Just (Set.fromList [MappedKey "ArtifactKind", MappedKey "ArtifactLocation"])+      map renderUsePath (usePaths graph "ArtifactLocation")+        `shouldBe` [ "Catalog command ObserveArtifact .artifact : ArtifactInfo .location : ArtifactLocation",+                     "Catalog event ArtifactObserved .artifact : ArtifactInfo .location : ArtifactLocation",+                     "Catalog register currentArtifact : ArtifactInfo .location : ArtifactLocation"+                   ]+    it "resolves every builtin through the complete expression algebra" $ do+      source <- TIO.readFile "test/fixtures/consumer-types.keiro"+      spec <- parseInlineSpec "test/fixtures/consumer-types.keiro" source+      graph <- shouldResolveTypeGraph spec+      case Map.lookup (MappedKey "ArtifactInfo") ((.declarations) graph) of+        Just (ResolvedStructural _ (RRecord _ _ fields)) ->+          Set.fromList (concatMap (foldTypeExpr expressionTags . (.valueType)) fields)+            `shouldBe` Set.fromList ["text", "int", "bool", "natural", "time", "json", "optional", "list", "map", "ref:ArtifactKind", "ref:ArtifactLocation"]+        declaration -> expectationFailure ("unexpected ArtifactInfo declaration: " <> show declaration)+    it "rejects direct, mutual, wrapped, and union-arm recursion" $ do+      let direct = mappedSpec [completeStructural "A" (recordShape [TRef "A"])]+          mutual = mappedSpec [completeStructural "A" (recordShape [TRef "B"]), completeStructural "B" (recordShape [TRef "A"])]+          wrapped = mappedSpec [completeStructural "A" (recordShape [TList (TOptional (TRef "A"))])]+          throughArm = mappedSpec [completeStructural "A" (ShapeUnion (TaggedObject "tag" "contents" RejectUnknown) [WireArm "Again" "again" (Just (TRef "A")) noLoc])]+      map (hasTypeGraphError isRecursive . resolveTypeGraph) [direct, mutual, wrapped, throughArm]+        `shouldBe` replicate 4 True+    it "resolves existing ids and enums as nominal leaves" $ do+      let withId =+            (mappedSpec [completeStructural "A" (recordShape [TRef "ExistingId"])])+              { ids = [IdDecl "ExistingId" "id" Nothing noLoc]+              }+          withEnum =+            (mappedSpec [completeStructural "A" (recordShape [TRef "ExistingEnum"])])+              { enums = [EnumDecl "ExistingEnum" [("One", "one")] Nothing noLoc]+              }+      graph <- shouldResolveTypeGraph withId+      Map.lookup (MappedKey "A") ((.nominalReachability) graph) `shouldBe` Just (Set.singleton "ExistingId")+      enumGraph <- shouldResolveTypeGraph withEnum+      Map.lookup (MappedKey "A") ((.nominalReachability) enumGraph) `shouldBe` Just (Set.singleton "ExistingEnum")+      ((.kind) <$> Map.lookup "ExistingEnum" ((.nominalLeaves) enumGraph))+        `shouldBe` Just (NominalEnumLeaf (("One", "one") :| []))+    it "fingerprints wire identity while ignoring Haskell selector names" $ do+      source <- TIO.readFile "test/fixtures/consumer-types.keiro"+      base <- parseInlineSpec "test/fixtures/consumer-types.keiro" source+      baseGraph <- shouldResolveTypeGraph base+      haskellRenameGraph <- shouldResolveTypeGraph (mapArtifactField (wireFieldWithHaskell "renamedKey") base)+      wireRenameGraph <- shouldResolveTypeGraph (mapArtifactField (wireFieldWithKey "renamed_key") base)+      wireFingerprint haskellRenameGraph "ArtifactInfo" `shouldBe` wireFingerprint baseGraph "ArtifactInfo"+      wireFingerprint wireRenameGraph "ArtifactInfo" `shouldNotBe` wireFingerprint baseGraph "ArtifactInfo"++  describe "semantic impact" $ do+    it "derives local aggregate closures and a complete service inventory" $ do+      source <- readTestText "test/fixtures/semantic-impact.keiro"+      spec <- parseInlineSpec "test/fixtures/semantic-impact.keiro" source+      graph <- shouldResolveTypeGraph spec+      let impact = semanticImpact graph+      aggregateMappedClosure impact "Alpha"+        `shouldBe` map MappedKey ["CommandPayload", "EventPayload", "NestedPayload", "RegisterPayload", "SharedPayload"]+      aggregateMappedClosure impact "Beta"+        `shouldBe` [MappedKey "SharedPayload"]+      mappedDeclarationConsumers impact (MappedKey "NestedPayload")+        `shouldBe` [AggregateConsumer "Alpha"]+      mappedDeclarationConsumers impact (MappedKey "SharedPayload")+        `shouldBe` [AggregateConsumer "Alpha", AggregateConsumer "Beta"]+      mappedDeclarationConsumers impact (MappedKey "UnusedPayload")+        `shouldBe` []+      Map.lookup (MappedKey "UnusedPayload") ((.declarationConsumers) impact)+        `shouldBe` Just Set.empty+      serviceMappedInventory impact+        `shouldBe` map MappedKey ["CommandPayload", "EventPayload", "NestedPayload", "RegisterPayload", "SharedPayload", "UnusedPayload"]+    it "folds command, private-event, and register roots explicitly" $ do+      source <- readTestText "test/fixtures/semantic-impact.keiro"+      spec <- parseInlineSpec "test/fixtures/semantic-impact.keiro" source+      impact <- semanticImpact <$> shouldResolveTypeGraph spec+      map (.kind) (aggregateMappedRoots impact "Alpha")+        `shouldBe` [MappedCommandFieldRoot, MappedCommandFieldRoot, MappedEventFieldRoot, MappedRegisterRoot]+      map (.kind) (aggregateMappedRoots impact "Beta")+        `shouldBe` [MappedRegisterRoot]+    it "is independent of declaration and aggregate traversal order" $ do+      source <- readTestText "test/fixtures/semantic-impact.keiro"+      spec <- parseInlineSpec "test/fixtures/semantic-impact.keiro" source+      baseline <- semanticImpact <$> shouldResolveTypeGraph spec+      reordered <-+        semanticImpact+          <$> shouldResolveTypeGraph+            spec+              { mapped = reverse ((.mapped) spec),+                nodes = reverse ((.nodes) spec)+              }+      reordered `shouldBe` baseline+    it "keeps future UseSite roots behind an exhaustive compile-time fold" $ do+      source <- readTestText "src/Keiro/Dsl/SemanticImpact.hs"+      source `shouldSatisfy` T.isInfixOf "{-# OPTIONS_GHC -Werror=incomplete-patterns #-}"+      map+        (`T.isInfixOf` source)+        [ "mappedRootFromUseSite site@UseSite {root = RootCommandField",+          "mappedRootFromUseSite site@UseSite {root = RootEventField",+          "mappedRootFromUseSite site@UseSite {root = RootRegister",+          "mappedRootFromUseSite site@UseSite {root = RootWorkqueueField",+          "mappedRootFromUseSite site@UseSite {root = RootReadModelQueryInput",+          "mappedRootFromUseSite site@UseSite {root = RootReadModelQueryResult"+        ]+        `shouldBe` replicate 6 True+      source `shouldSatisfy` (not . T.isInfixOf "mappedRootFromUseSite _")+    it "round-trips canonical snapshots and reports only checked consumer membership changes" $ do+      spec <- specOf "test/fixtures/semantic-impact.keiro"+      snapshot <- semanticImpactSnapshot . semanticImpact <$> shouldResolveTypeGraph spec+      Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot+      let shared = MappedKey "SharedPayload"+          changed =+            snapshot+              { mappedConsumers =+                  Map.adjust (Set.delete (AggregateConsumer "Beta")) shared ((.mappedConsumers) snapshot)+              }+      case diffSemanticImpact snapshot changed of+        [delta] -> do+          (.declaration) delta `shouldBe` shared+          (.previousConsumers) delta `shouldBe` Set.fromList [AggregateConsumer "Alpha", AggregateConsumer "Beta"]+          (.currentConsumers) delta `shouldBe` Set.singleton (AggregateConsumer "Alpha")+          (.serviceConformance) delta `shouldBe` True+        deltas -> expectationFailure ("expected one semantic-impact delta, got " <> show deltas)+      case mappedImpactForDeclarations [MappedKey "NestedPayload"] snapshot snapshot of+        [delta] -> do+          (.declaration) delta `shouldBe` MappedKey "NestedPayload"+          (.previousConsumers) delta `shouldBe` Set.singleton (AggregateConsumer "Alpha")+          (.currentConsumers) delta `shouldBe` Set.singleton (AggregateConsumer "Alpha")+          (.previousEvidence) delta `shouldSatisfy` maybe False (not . Set.null)+          (.currentConsequences) delta `shouldSatisfy` maybe False (not . Set.null)+        deltas -> expectationFailure ("expected one nested semantic-impact delta, got " <> show deltas)+    it "round-trips additive semantic impact ledger rows and rejects known-row corruption" $ do+      spec <- specOf "test/fixtures/semantic-impact.keiro"+      let snapshot = semanticImpactSnapshotForSpec spec+          singleRecord =+            ScaffoldRecord+              { specPath = "semantic-impact.keiro",+                moduleRoot = "",+                layout = "prefixed",+                sourceLanguage = LegacyUnversioned,+                languageContract = effectiveLanguageContract LegacyUnversioned,+                namingEdition = IdiomaticNamingV1,+                moduleRoles = [],+                files = [],+                mappings = [],+                idDomains = [],+                nominalEqualities = [],+                bindingObligations = [],+                behaviorRequirements = [],+                projectionCatalogFacts = [],+                queryContractBaseline = True,+                queryContracts = either (const []) id (queryContractIdentities spec),+                routerSelections = [],+                processReactions = [],+                semanticImpact = Just snapshot+              }+          encoded = renderRecord singleRecord+          semanticRows = filter ("semantic-impact " `T.isPrefixOf`) (T.lines encoded)+          legacyEncoded = T.unlines (filter (not . T.isPrefixOf "semantic-impact ") (T.lines encoded))+          futureEncoded = T.replace "semantic-impact {" "semantic-impact {\"future\":true," encoded+          emptyIdentitySnapshot =+            SemanticImpactSnapshot+              { mappedConsumers = snapshot.mappedConsumers,+                mappedEvidence = snapshot.mappedEvidence,+                mappedConsequences = snapshot.mappedConsequences,+                serviceInventory = snapshot.serviceInventory,+                declarationIdentities = Map.adjust (const "") (MappedKey "CommandPayload") snapshot.declarationIdentities+              }+      length semanticRows `shouldBe` 1+      parseRecord encoded `shouldBe` Just singleRecord+      (.semanticImpact) <$> parseRecord legacyEncoded `shouldBe` Just Nothing+      parseRecord futureEncoded `shouldBe` Just singleRecord+      (Aeson.decode (Aeson.encode emptyIdentitySnapshot) :: Maybe SemanticImpactSnapshot) `shouldBe` Nothing+      case semanticRows of+        [row] -> do+          parseRecord (encoded <> row <> "\n") `shouldBe` Nothing+          let duplicateConsumer = T.replace "\"consumers\":[\"Alpha\",\"Beta\"]" "\"consumers\":[\"Alpha\",\"Alpha\"]" encoded+          duplicateConsumer `shouldNotBe` encoded+          parseRecord duplicateConsumer `shouldBe` Nothing+        _ -> expectationFailure "expected exactly one semantic-impact row"+      workspace <- shouldComposeWorkspace canonicalWorkspacePath+      let workspaceRecord = (sampleWorkspaceRecord workspace) {WorkspaceRecord.semanticImpact = Just snapshot}+          workspaceEncoded = renderWorkspaceRecord workspaceRecord+      T.count "semantic-impact " workspaceEncoded `shouldBe` 1+      parseWorkspaceRecord workspaceEncoded `shouldBe` Just workspaceRecord+      parseWorkspaceRecord (workspaceEncoded <> "future-row ignored\n") `shouldBe` Just workspaceRecord++  describe "string literal integrity" $ do+    it "parses an escaped emit-map value as exactly one row" $ do+      let src =+            T.unlines+              [ "context svc",+                "",+                "emit e {",+                "  contract c",+                "  topic events",+                "  source \"svc\"",+                "  key thingId",+                "  map status {",+                "    \"a\\\" => Wat \\\"b\" => ThingAccepted",+                "    _ => skip",+                "  }",+                "  messageId derive hole",+                "  idempotencyKey derive hole",+                "}"+              ]+      case parseSpec "<escaped-map>" src of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> case [row | NEmit e <- (.nodes) spec, row <- e.map] of+          [row] -> do+            (.value) row `shouldBe` "a\" => Wat \"b"+            (.event) row `shouldBe` "ThingAccepted"+          rows -> expectationFailure ("expected one emit-map row, got " <> show (length rows))+    it "rejects a raw newline inside a quoted string" $ do+      let src = "context svc\n\ncontract c {\n  schemaVersion 1\n  discriminator kind\n  topic events \"first\nsecond\"\n}\n"+      parseSpec "<raw-newline>" src `shouldSatisfy` leftContains "unescaped newline"+    it "rejects an unknown escape sequence" $ do+      let src = "context svc\n\ncontract c {\n  schemaVersion 1\n  discriminator kind\n  topic events \"bad\\q\"\n}\n"+      parseSpec "<unknown-escape>" src `shouldSatisfy` leftContains "unknown escape"+    it "round-trips adversarial text through topics, emit maps, and quoted bindings" $+      property $+        forAll genAdversarialText $ \t ->+          let spec = escapedSpec t+              rendered = renderSpec spec+           in counterexample (T.unpack rendered) (parseSpec "<escaped-round-trip>" rendered === Right spec)++  describe "partial status maps" $ do+    it "suppresses totality only when the partial marker is present" $ do+      partial <- parseInlineSpec "<partial-status-map>" (statusMapSpec " partial")+      totalSpec <- parseInlineSpec "<total-status-map>" (statusMapSpec "")+      map (.code) (validateSpec partial) `shouldNotContain` [StatusMapNotTotal]+      map (.code) (validateSpec totalSpec) `shouldContain` [StatusMapNotTotal]+      parseSpec "<partial-round-trip>" (renderSpec partial) `shouldBe` Right partial++  describe "positioned parser diagnostics" $ do+    it "rejects a duplicate goto at the second clause" $ do+      err <- parseErrorOf "<duplicate-goto>" duplicateGotoSpec+      err `shouldSatisfy` T.isInfixOf "duplicate goto"+      err `shouldSatisfy` T.isInfixOf "<duplicate-goto>:10:"+    it "rejects duplicate wire and projection blocks at their second occurrences" $ do+      wireErr <- parseErrorOf "<duplicate-wire>" duplicateWireSpec+      wireErr `shouldSatisfy` T.isInfixOf "duplicate wire block"+      wireErr `shouldSatisfy` T.isInfixOf "<duplicate-wire>:8:"+      projectionErr <- parseErrorOf "<duplicate-projection>" duplicateProjectionSpec+      projectionErr `shouldSatisfy` T.isInfixOf "duplicate projection block"+      projectionErr `shouldSatisfy` T.isInfixOf "<duplicate-projection>:9:"+    it "anchors a missing goto on the transition line" $ do+      err <- parseErrorOf "<missing-goto>" missingGotoSpec+      err `shouldSatisfy` T.isInfixOf "missing a goto clause"+      err `shouldSatisfy` T.isInfixOf "<missing-goto>:8:"+    it "stops before a misplaced dispatch-id and expects schedule at its start" $ do+      let src = misplacedDispatchIdSpec+          expectedPosition =+            "<misplaced-dispatch-id>:"+              <> T.pack (show (lineNumberContaining "dispatch-id" src))+              <> ":5:"+      err <- parseErrorOf "<misplaced-dispatch-id>" src+      err `shouldSatisfy` T.isInfixOf "schedule"+      err `shouldSatisfy` T.isInfixOf expectedPosition+    it "keeps a malformed register declaration's equals error" $ do+      err <- parseErrorOf "<malformed-register>" malformedRegisterSpec+      err `shouldSatisfy` T.isInfixOf "expecting '='"++  describe "bounded decimal literals" $ do+    forM_ decimalOverflowSpecs $ \(site, src) ->+      it ("rejects overflow at " <> site) $ do+        err <- parseErrorOf ("<overflow-" <> site <> ">") src+        err `shouldSatisfy` T.isInfixOf ("decimal literal " <> decimalOverflow <> " is out of range")+    it "accepts maxBound without changing its value" $ do+      spec <- parseInlineSpec "<max-bound>" (wireDecimalSpec (T.pack (show (maxBound :: Int))))+      [wire.schemaVersion | NAggregate aggregate <- (.nodes) spec, Just wire <- [(.wire) aggregate]]+        `shouldBe` [maxBound]++  describe "identifier hygiene" $ do+    it "normalizes lowercase logical type names and reports generated Haskell keywords at their owning declarations" $ do+      spec <- parseInlineSpec "<identifier-hygiene>" identifierHygieneSpec+      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- validateSpec spec, (.code) diagnostic `elem` [IdentUnsafeNormalization, GeneratedOccurrenceReserved]]+        `shouldBe` [(GeneratedOccurrenceReserved, 7)]+    it "rejects generated vertex constructors that collide with event constructors" $ do+      spec <- parseInlineSpec "<vertex-collision>" vertexCollisionSpec+      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- validateSpec spec, (.code) diagnostic == VertexCtorCollision]+        `shouldBe` [(VertexCtorCollision, 3)]+    it "rejects underscore-leading names whose normalization would erase a word boundary" $ do+      spec <- parseInlineSpec "<underscore-node>" underscoreNodeSpec+      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- validateSpec spec, (.code) diagnostic == IdentUnsafeNormalization]+        `shouldBe` [(IdentUnsafeNormalization, 3)]+    it "rejects normalized module collisions with both source locations" $ do+      spec <- parseInlineSpec "<normalized-collision>" normalizedCollisionSpec+      case [diagnostic | diagnostic <- validateSpec spec, (.code) diagnostic == GeneratedOccurrenceCollision] of+        [diagnostic] -> do+          (.line) diagnostic `shouldBe` 8+          (.relatedLocations) diagnostic `shouldBe` [(3, "'fooBar' also normalizes here")]+          renderDiagnostic "<normalized-collision>" diagnostic `shouldSatisfy` T.isInfixOf "fooBar"+        diagnostics -> expectationFailure ("expected one normalized collision, got " <> show diagnostics)+    it "validates explicit selectors and detects selector collisions in aggregate and contract records" $ do+      service <-+        checkedServiceFromText+          "<field-selector-validation>"+          ( T.unlines+              [ "language keiro-dsl 4",+                "context aliases",+                "aggregate Order",+                "  regs",+                "  states Open",+                "  command Change {",+                "    first haskell shared:Text",+                "    second haskell shared:Text",+                "    reserved haskell type:Text",+                "    invalid haskell Bad:Text",+                "  }",+                "contract publicOrder {",+                "  schemaVersion 1",+                "  discriminator kind",+                "  topic changes \"orders.v1\"",+                "  event Changed on changes {",+                "    first haskell duplicate: text",+                "    second haskell duplicate: text",+                "  }",+                "}"+              ]+          )+      let diagnostics = validateService service+          selectorCollisions = [diagnostic | diagnostic <- diagnostics, (.code) diagnostic == GeneratedOccurrenceCollision]+      [((.code) diagnostic, (.line) diagnostic) | diagnostic <- diagnostics, (.code) diagnostic `elem` [GeneratedOccurrenceReserved, IdentUnsafeNormalization]]+        `shouldBe` [(GeneratedOccurrenceReserved, 9), (IdentUnsafeNormalization, 10)]+      map (.line) selectorCollisions `shouldBe` [8, 18]+      map (.relatedLocations) selectorCollisions+        `shouldBe` [ [(7, "'first' also normalizes here")],+                     [(17, "'first' also normalizes here")]+                   ]+    it "rejects empty, duplicate, and envelope-colliding resolved wire keys with field-local evidence" $ do+      service <-+        checkedServiceFromText+          "<field-wire-validation>"+          ( T.unlines+              [ "language keiro-dsl 4",+                "context aliases",+                "aggregate Order",+                "  regs",+                "  states Open",+                "  command Change {",+                "    first as \"same\":Text",+                "    second as \"same\":Text",+                "    empty as \"\":Text",+                "  }",+                "  event Changed { value as \"kind\":Text }",+                "contract publicOrder {",+                "  schemaVersion 1",+                "  discriminator kind",+                "  topic changes \"orders.v1\"",+                "  event Published on changes { value as \"kind\": text }",+                "}"+              ]+          )+      let diagnostics = validateService service+          wireDiagnostics = [diagnostic | diagnostic <- diagnostics, (.code) diagnostic `elem` [FieldWireKeyCollision, FieldWireKeyInvalid]]+      map (\diagnostic -> ((.code) diagnostic, (.line) diagnostic)) wireDiagnostics+        `shouldBe` [ (FieldWireKeyCollision, 8),+                     (FieldWireKeyInvalid, 9),+                     (FieldWireKeyCollision, 11),+                     (FieldWireKeyCollision, 16)+                   ]+      case wireDiagnostics of+        firstDiagnostic : _ -> (.relatedLocations) firstDiagnostic `shouldBe` [(7, "wire key 'same' is first declared here")]+        [] -> expectationFailure "expected resolved wire-key diagnostics"+    -- `family` is a contextual keyword GHC accepts as a term under the+    -- advertised GHC2024 contract, and it is the field mori's project signals+    -- are keyed by. This fixture pins that scenario end to end; before ExecPlan+    -- 199 no test referenced it, so the guarantee was untested.+    it "keeps a reserved-word-adjacent contract field intact from check to codec" $+      withTempDirectory "keiro-dsl-reserved-family" $ \out -> do+        let fixture = "test/fixtures/contract-reserved-family.keiro"+        (checkCode, checkOut, checkErr) <- runKeiroDsl ["check", fixture, "--min-language", "4", "--deny-warnings"]+        unless (checkCode == ExitSuccess) (expectationFailure (checkOut <> checkErr))+        checkOut `shouldBe` "OK\n"+        checkErr `shouldNotContain` "warning["++        (scaffoldCode, scaffoldOut, scaffoldErr) <- runKeiroDsl ["scaffold", fixture, "--out", out]+        unless (scaffoldCode == ExitSuccess) (expectationFailure (scaffoldOut <> scaffoldErr))+        tree <- treeSnapshot out+        case [text | (path, text) <- tree, "Contract.hs" `T.isSuffixOf` T.pack path] of+          codec : _ -> do+            -- The DSL name is the record selector …+            codec `shouldSatisfy` T.isInfixOf "family ::"+            -- … and, unaliased, the wire key is the same bytes.+            codec `shouldSatisfy` T.isInfixOf "\"family\""+            codec `shouldNotSatisfy` T.isInfixOf "family_"+          [] -> expectationFailure ("no generated contract module in " <> show (map fst tree))++    -- An alias exists to preserve a brownfield key the current convention would+    -- reject, so its *style* is deliberately not checked (ADR 0021). What is+    -- checked is that the key can be a key: a trailing space or a control+    -- character ships a permanently mis-keyed public field. See ExecPlan 199.+    it "refuses structurally unusable wire-key aliases without opinionating on style" $ do+      let aliasSpec alias =+            T.unlines+              [ "language keiro-dsl 4",+                "context aliases",+                "aggregate Order",+                "  regs",+                "  states Open",+                "  command Change {",+                "    region as \"" <> alias <> "\":Text",+                "  }"+              ]+          keyDiagnostics source = do+            service <- checkedServiceFromText "<alias-content>" source+            pure [diagnostic | diagnostic <- validateService service, (.code) diagnostic == FieldWireKeyInvalid]++      -- Refused: the wire key is the exact bytes on the wire. Written as the+      -- DSL spells them, so `\\n` here is the source's escape, not Haskell's.+      forM_ ["family ", " family", "family\\n", "fam\\tily", "fam\\rily"] $ \bad -> do+        refused <- keyDiagnostics (aliasSpec bad)+        map (.code) refused `shouldBe` [FieldWireKeyInvalid]+        map (.line) refused `shouldBe` [7]++      -- Accepted: these violate `fields=camelCase` and that is exactly the point+      -- of an alias — the brownfield key is preserved, not corrected.+      forM_ ["region_code", "Region-Code", "REGION.CODE", "r\233gion"] $ \brownfield -> do+        accepted <- keyDiagnostics (aliasSpec brownfield)+        accepted `shouldBe` []++    -- The collision planner must register the selector generation actually+    -- emits. Registering a camelized rendering of the raw name made it claim+    -- `foo_bar` "normalizes to" `fooBar`, which generation never does.+    it "plans field collisions against the emitted selector, not a camelized rendering" $ do+      let recordSpec fields =+            T.unlines+              [ "language keiro-dsl 4",+                "context aliases",+                "aggregate Order",+                "  regs",+                "  states Open",+                "  command Change { " <> fields <> " }"+              ]+          collisionsIn source = do+            service <- checkedServiceFromText "<selector-collision>" source+            pure [diagnostic | diagnostic <- validateService service, (.code) diagnostic == GeneratedOccurrenceCollision]++      -- Distinct emitted selectors: `foo_bar` generates `foo_bar`. It is still+      -- refused, but by the generated-name audit that owns lowerCamelCase — not+      -- by a collision claim naming an unrelated sibling.+      falseCollision <- collisionsIn (recordSpec "foo_bar fooBar")+      falseCollision `shouldBe` []++      -- Two declarations that really do emit one selector still collide.+      realCollision <- collisionsIn (recordSpec "fooBar other haskell fooBar")+      map (.code) realCollision `shouldSatisfy` \codes -> GeneratedOccurrenceCollision `elem` codes++    it "checks copied command selectors in both generated record scopes" $ do+      service <-+        checkedServiceFromText+          "<copied-selector-collision>"+          ( T.unlines+              [ "language keiro-dsl 4",+                "context aliases",+                "aggregate Order",+                "  regs",+                "  states Open",+                "  command Change { first haskell shared:Text second haskell shared:Text }",+                "  event Changed = fields(Change)"+              ]+          )+      [(.line) diagnostic | diagnostic <- validateService service, (.code) diagnostic == GeneratedOccurrenceCollision]+        `shouldBe` [6, 6]+    it "anchors repeated reserved contract fields at their own lines and maps them through workspaces" $ do+      service <-+        checkedServiceFromText+          "domain/member.keiro"+          ( T.unlines+              [ "language keiro-dsl 4",+                "context aliases",+                "contract publicOrder {",+                "  schemaVersion 1",+                "  discriminator kind",+                "  topic changes \"orders.v1\"",+                "  event First on changes { where: text }",+                "  event Second on changes { where: text }",+                "}"+              ]+          )+      [(.line) diagnostic | diagnostic <- validateService service, (.code) diagnostic == GeneratedOccurrenceReserved]+        `shouldBe` [7, 8]+      let workspaceDiagnostics =+            [ diagnostic+            | diagnostic <- checkWorkspace (oneMemberWorkspace "domain/member.keiro" (checkedSpec service)),+              (.code) diagnostic == GeneratedOccurrenceReserved+            ]+          workspaceLocations =+            [ ((.file) location, (.line) location)+            | diagnostic <- workspaceDiagnostics,+              location <- NE.toList ((.locations) diagnostic)+            ]+      workspaceLocations+        `shouldBe` [ (WorkspaceMemberFile "member.keiro", 7),+                     (WorkspaceMemberFile "member.keiro", 8)+                   ]+    it "rejects non-ASCII identifier characters in the parser" $+      parseSpec "<unicode-identifier>" unicodeIdentifierSpec `shouldSatisfy` leftContains "unexpected"++  describe "Haskell.name-audit" $ do+    it "inventories every declaration in a fresh compound-name scaffold" $ do+      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      let service = legacyCheckedService spec+          ctx = defaultContext (spec.context)+          modules = scaffoldServiceModules ctx service+      concatMap auditGeneratedHaskell modules `shouldBe` []+    it "rejects underscore module and declaration mutations but ignores literals and comments" $ do+      let mutated =+            ScaffoldModule+              { path = "Generated/IncidentPaging/Service_oncall/Mutation.hs",+                text =+                  T.unlines+                    [ "module Generated.IncidentPaging.Service_oncall.Mutation where",+                      "-- comment_value :: Text",+                      "literalValue = \"string_value\"",+                      "render_eventTypes :: Int",+                      "render_eventTypes = 1"+                    ],+                kind = Generated,+                origin = "test name-audit mutation"+              }+          violations = auditGeneratedHaskell mutated+      violations `shouldSatisfy` any (T.isInfixOf "Service_oncall")+      violations `shouldSatisfy` any (T.isInfixOf "render_eventTypes")+      violations `shouldSatisfy` all (not . T.isInfixOf "comment_value")+      violations `shouldSatisfy` all (not . T.isInfixOf "string_value")+    it "rejects repeated generated signatures before writing" $ do+      let mutated =+            ScaffoldModule+              { path = "Generated/Repeated.hs",+                text =+                  T.unlines+                    [ "module Generated.Repeated where",+                      "sameValue :: Bool",+                      "sameValue = True",+                      "sameValue :: Bool",+                      "sameValue = False"+                    ],+                kind = Generated,+                origin = "test repeated declaration"+              }+      auditGeneratedHaskell mutated `shouldSatisfy` any (T.isInfixOf "repeated top-level type signature 'sameValue'")++  describe "Haskell.name-migration" $ do+    it "pairs a legacy module path with its stable idiomatic artifact" $ do+      let currentModule =+            ScaffoldModule+              { path = "Generated/IncidentPaging/ServiceOncall/ReadModel.hs",+                text = "module Generated.IncidentPaging.ServiceOncall.ReadModel where\n",+                kind = Generated,+                origin = "readmodel service_oncall ReadModel"+              }+      planSourceMoves [(Nothing, Generated, "Generated/IncidentPaging/Service_oncall/ReadModel.hs")] [currentModule]+        `shouldBe` Right+          [ SourceMove+              { role = moduleRole currentModule,+                kind = Generated,+                oldModule = "Generated.IncidentPaging.Service_oncall.ReadModel",+                newModule = "Generated.IncidentPaging.ServiceOncall.ReadModel",+                oldPath = "Generated/IncidentPaging/Service_oncall/ReadModel.hs",+                newPath = "Generated/IncidentPaging/ServiceOncall/ReadModel.hs",+                backupPath = ".keiro-dsl-name-migrations/legacy-v1-to-idiomatic-v1/Generated/IncidentPaging/Service_oncall/ReadModel.hs",+                contentDigest = Nothing,+                transformedDigest = Nothing+              }+          ]+    it "rewrites code-token module references while preserving comments and literals" $ do+      let old = "Generated.IncidentPaging.Service_oncall.ReadModel"+          new = "Generated.IncidentPaging.ServiceOncall.ReadModel"+          source =+            T.unlines+              [ "module IncidentPaging.Service_oncall.ReadModelHoles where",+                "import Generated.IncidentPaging.Service_oncall.ReadModel",+                "value = Generated.IncidentPaging.Service_oncall.ReadModel.constructor",+                "-- Generated.IncidentPaging.Service_oncall.ReadModel in a comment",+                "literal = \"Generated.IncidentPaging.Service_oncall.ReadModel\"",+                "character = 'x'",+                "{- outer {- Generated.IncidentPaging.Service_oncall.ReadModel -} comment -}"+              ]+      case rewriteHaskellModuleReferences (Map.singleton old new) source of+        Left err -> expectationFailure (show err)+        Right rewritten -> do+          rewritten `shouldSatisfy` T.isInfixOf "import Generated.IncidentPaging.ServiceOncall.ReadModel"+          rewritten `shouldSatisfy` T.isInfixOf "value = Generated.IncidentPaging.ServiceOncall.ReadModel.constructor"+          rewritten `shouldSatisfy` T.isInfixOf "-- Generated.IncidentPaging.Service_oncall.ReadModel in a comment"+          rewritten `shouldSatisfy` T.isInfixOf "literal = \"Generated.IncidentPaging.Service_oncall.ReadModel\""+          rewritten `shouldSatisfy` T.isInfixOf "{- outer {- Generated.IncidentPaging.Service_oncall.ReadModel -} comment -}"+    it "requires both flags when a legacy ledger needs only sidecar renames" $ do+      withTempDirectory "keiro-dsl-sidecar-only-name-migration" $ \out -> do+        spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+        let service = legacyCheckedService spec+            ctx = defaultContext (spec.context)+        modules <- case planTestServiceScaffold ctx service of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right planned -> pure planned+        initial <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing False False out False "incident-paging.keiro" LegacyUnversioned ctx service modules+        case initial of+          Left refusals -> expectationFailure (show refusals)+          Right _ -> pure ()+        let recordPath = out </> recordFileName (spec.context)+            fragmentPath = out </> contextCabalFragmentFileName (spec.context)+        currentRecord <-+          TIO.readFile recordPath >>= \contents ->+            maybe (expectationFailure "fresh scaffold record did not parse" >> fail "unreachable") pure (parseRecord contents)+        TIO.writeFile recordPath (renderRecord (scaffoldRecordWithEdition LegacyNamingV1 currentRecord))+        renameFile recordPath (out </> legacyContextRecordFileName (spec.context))+        renameFile fragmentPath (out </> legacyContextManifestFileName (spec.context))+        nameOnly <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True False out False "incident-paging.keiro" LegacyUnversioned ctx service modules+        nameOnly `shouldSatisfy` \case+          Left [NameMigrationRequired [], GeneratedHaskellEditionRequired impact, SidecarMovesAlreadyApplied sidecars] ->+            (.fromEdition) impact == LegacyNamingV1 && length sidecars == 2+          _ -> False++      withTempDirectory "keiro-dsl-workspace-sidecar-only-name-migration" $ \out -> do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        plan <- shouldPlanWorkspaceSpec workspace+        initial <- executeWorkspaceScaffold out False plan+        case initial of+          Left refusals -> expectationFailure (show refusals)+          Right _ -> pure ()+        let service = (.service) workspace+            recordPath = out </> workspaceRecordFileName service+            fragmentPath = out </> workspaceManifestFileName service+        currentRecord <-+          TIO.readFile recordPath >>= \contents ->+            maybe (expectationFailure "fresh workspace record did not parse" >> fail "unreachable") pure (parseWorkspaceRecord contents)+        TIO.writeFile recordPath (renderWorkspaceRecord (workspaceRecordWithEditionAndModules LegacyNamingV1 currentRecord.modules currentRecord))+        renameFile recordPath (out </> legacyWorkspaceRecordFileName service)+        renameFile fragmentPath (out </> legacyWorkspaceManifestFileName service)+        nameOnly <- executeWorkspaceScaffoldWithMigrations out False True False plan+        nameOnly `shouldSatisfy` \case+          Left [NameMigrationRequired [], GeneratedHaskellEditionRequired impact, SidecarMovesAlreadyApplied sidecars] ->+            (.fromEdition) impact == LegacyNamingV1 && length sidecars == 2+          _ -> False+    it "refuses without mutation, then applies recoverable generated and hole moves" $+      withTempDirectory "keiro-dsl-name-migration" $ \out -> do+        spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+        let service = legacyCheckedService spec+            ctx = defaultContext (spec.context)+        modules <- case planTestServiceScaffold ctx service of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right planned -> pure planned+        let selected =+              [ scaffoldModule+              | scaffoldModule <- modules,+                any (`T.isSuffixOf` T.pack ((.path) scaffoldModule)) ["ServiceOncall/ReadModel.hs", "ServiceOncall/ReadModelHoles.hs"]+              ]+            legacyPath = T.unpack . T.replace "ServiceOncall" "Service_oncall" . T.pack+            reverseModules =+              Map.fromList+                [ (moduleNameFromPath ((.path) scaffoldModule), moduleNameFromPath (legacyPath ((.path) scaffoldModule)))+                | scaffoldModule <- selected+                ]+        forM_ selected $ \scaffoldModule -> do+          legacyText <- case rewriteHaskellModuleReferences reverseModules ((.text) scaffoldModule) of+            Left err -> expectationFailure (show err) >> fail "unreachable"+            Right source -> pure source+          let oldPath = out </> legacyPath ((.path) scaffoldModule)+              withEvidence+                | (.kind) scaffoldModule == HoleStub =+                    legacyText+                      <> "\n-- Generated.IncidentPaging.Service_oncall.ReadModel remains in this comment\n"+                      <> "migrationLiteral = \"Generated.IncidentPaging.Service_oncall.ReadModel\"\n"+                | otherwise = legacyText+          createDirectoryIfMissing True (takeDirectory oldPath)+          TIO.writeFile oldPath withEvidence+        let legacyRecord =+              ScaffoldRecord+                { specPath = "incident-paging.keiro",+                  moduleRoot = "",+                  layout = "prefixed",+                  sourceLanguage = LegacyUnversioned,+                  languageContract = effectiveLanguageContract LegacyUnversioned,+                  namingEdition = LegacyNamingV1,+                  moduleRoles = [],+                  files = [((.kind) scaffoldModule, legacyPath ((.path) scaffoldModule)) | scaffoldModule <- selected],+                  mappings = [],+                  idDomains = [],+                  nominalEqualities = [],+                  bindingObligations = [],+                  behaviorRequirements = [],+                  projectionCatalogFacts = [],+                  queryContractBaseline = False,+                  queryContracts = [],+                  routerSelections = [],+                  processReactions = [],+                  semanticImpact = Nothing+                }+            recordPath = out </> recordFileName (spec.context)+        TIO.writeFile recordPath (renderRecord legacyRecord)+        let currentFragment = out </> contextCabalFragmentFileName (spec.context)+            legacyRecordPath = out </> legacyContextRecordFileName (spec.context)+            legacyFragmentPath = out </> legacyContextManifestFileName (spec.context)+        TIO.writeFile currentFragment "legacy cabal fragment\n"+        renameFile recordPath legacyRecordPath+        renameFile currentFragment legacyFragmentPath+        beforeMigration <- treeSnapshot out+        refused <- executeServiceScaffoldWithRuntimePackageAndNameMigrations Nothing False out False "incident-paging.keiro" LegacyUnversioned ctx service modules+        refused `shouldSatisfy` \case+          Left [SidecarMigrationRequired sidecars, GeneratedHaskellEditionRequired impact] ->+            length sidecars == 2 && (.fromEdition) impact == LegacyNamingV1+          _ -> False+        renderRefusals (either id (const []) refused)+          `shouldSatisfy` any (T.isInfixOf "needs both --apply-name-migrations and --apply-generated-haskell-edition")+        treeSnapshot out `shouldReturn` beforeMigration++        nameOnly <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True False out False "incident-paging.keiro" LegacyUnversioned ctx service modules+        nameOnly `shouldSatisfy` \case+          Left [NameMigrationRequired moves, GeneratedHaskellEditionRequired impact, SidecarMovesAlreadyApplied sidecars] ->+            length moves == 2+              && all ((/= Nothing) . (.contentDigest)) moves+              && all ((/= Nothing) . (.transformedDigest)) moves+              && (.fromEdition) impact == LegacyNamingV1+              && length sidecars == 2+          _ -> False+        applied <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True True out False "incident-paging.keiro" LegacyUnversioned ctx service modules+        report <- case applied of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right value -> pure value+        length ((.nameMoves) report) `shouldBe` 2+        let editionBackupRoot = out </> ".keiro-dsl-generated-haskell-migrations/legacy-v1-to-idiomatic-v2"+        doesFileExist (editionBackupRoot </> recordFileName (spec.context)) `shouldReturn` True+        doesFileExist (editionBackupRoot </> contextCabalFragmentFileName (spec.context)) `shouldReturn` True+        remediation <- TIO.readFile (editionBackupRoot </> "remediation-report.txt")+        remediation `shouldSatisfy` T.isInfixOf "source-moves: 2"+        remediation `shouldSatisfy` T.isInfixOf "Service_oncall/ReadModel.hs -> Generated/IncidentPaging/ServiceOncall/ReadModel.hs"+        let newHole = out </> "IncidentPaging/ServiceOncall/ReadModelHoles.hs"+            oldHole = out </> "IncidentPaging/Service_oncall/ReadModelHoles.hs"+            backupHole = out </> ".keiro-dsl-name-migrations/legacy-v1-to-idiomatic-v1/IncidentPaging/Service_oncall/ReadModelHoles.hs"+        doesFileExist oldHole `shouldReturn` False+        doesFileExist newHole `shouldReturn` True+        doesFileExist backupHole `shouldReturn` True+        migratedHole <- TIO.readFile newHole+        migratedHole `shouldSatisfy` T.isInfixOf "module IncidentPaging.ServiceOncall.ReadModelHoles"+        migratedHole `shouldSatisfy` T.isInfixOf "-- Generated.IncidentPaging.Service_oncall.ReadModel remains in this comment"+        migratedHole `shouldSatisfy` T.isInfixOf "migrationLiteral = \"Generated.IncidentPaging.Service_oncall.ReadModel\""+        backupBefore <- TIO.readFile backupHole+        rerun <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True True out False "incident-paging.keiro" LegacyUnversioned ctx service modules+        case rerun of+          Left refusals -> expectationFailure (show refusals)+          Right rerunReport -> (.nameMoves) rerunReport `shouldBe` []+        TIO.readFile backupHole `shouldReturn` backupBefore+        -- Recreate the exact crash state after every backup and prepared file+        -- exists but before any destination is installed. A corrupted prepared+        -- file refuses; restoring its digest lets the next run resume.+        preparedSnapshots <- forM selected $ \scaffoldModule -> do+          let newPath = out </> (.path) scaffoldModule+              preparedPath = newPath <> ".keiro-dsl-name-migration-prepared"+          bytes <- TIO.readFile newPath+          renameFile newPath preparedPath+          pure (preparedPath, bytes)+        -- This is specifically the name-move crash state. Keep the ledger at+        -- the current presentation edition so the independent edition-backup+        -- conflict gate does not mask the prepared-source digest check.+        TIO.writeFile recordPath (renderRecord (scaffoldRecordWithEdition IdiomaticNamingV2 legacyRecord))+        case preparedSnapshots of+          (firstPrepared, firstBytes) : _ -> TIO.writeFile firstPrepared (firstBytes <> "\ncorrupt")+          [] -> expectationFailure "expected prepared migration sources"+        conflicted <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True True out False "incident-paging.keiro" LegacyUnversioned ctx service modules+        conflicted `shouldSatisfy` \case Left [NameMigrationRefusal messages] -> any (T.isInfixOf "prepared source digest") messages; _ -> False+        forM_ preparedSnapshots (uncurry TIO.writeFile)+        resumed <- executeServiceScaffoldWithRuntimePackageAndMigrations Nothing True True out False "incident-paging.keiro" LegacyUnversioned ctx service modules+        case resumed of+          Left refusals -> expectationFailure (show refusals)+          Right resumedReport -> length ((.nameMoves) resumedReport) `shouldBe` 2+        doesFileExist newHole `shouldReturn` True+        TIO.readFile backupHole `shouldReturn` backupBefore+    it "applies the same move protocol to a two-member workspace without changing ownership" $+      withTempDirectory "keiro-dsl-workspace-name-migration" $ \out -> do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        plan <- shouldPlanWorkspaceSpec workspace+        initial <- executeWorkspaceScaffold out False plan+        case initial of+          Left refusals -> expectationFailure (show refusals)+          Right _ -> pure ()+        let recordPath = out </> workspaceRecordFileName ((.service) workspace)+        currentRecord <-+          TIO.readFile recordPath >>= \contents ->+            maybe (expectationFailure "fresh workspace record did not parse" >> fail "unreachable") pure (parseWorkspaceRecord contents)+        let selectedRows = [row | row <- (.modules) currentRecord, "ProjectActivity" `T.isInfixOf` T.pack ((.path) row)]+            legacyPath = T.unpack . T.replace "ProjectActivity" "Project_activity" . T.pack+            reverseModules =+              Map.fromList+                [ (moduleNameFromPath ((.path) row), moduleNameFromPath (legacyPath ((.path) row)))+                | row <- selectedRows+                ]+        selectedRows `shouldSatisfy` (not . null)+        forM_ selectedRows $ \row -> do+          currentSource <- TIO.readFile (out </> (.path) row)+          legacySource <- case rewriteHaskellModuleReferences reverseModules currentSource of+            Left err -> expectationFailure (show err) >> fail "unreachable"+            Right source -> pure source+          writeFileWithParents (out </> legacyPath ((.path) row)) legacySource+          removeFile (out </> (.path) row)+        let legacyRecord =+              workspaceRecordWithEditionAndModules+                LegacyNamingV1+                [ if row `elem` selectedRows then workspaceModuleRowWithPath (legacyPath row.path) row else row+                | row <- currentRecord.modules+                ]+                currentRecord+            ownersBefore = Map.fromList [((.role) row, (.owner) row) | row <- selectedRows]+        TIO.writeFile recordPath (renderWorkspaceRecord legacyRecord)+        let currentFragment = out </> workspaceManifestFileName ((.service) workspace)+            legacyRecordPath = out </> legacyWorkspaceRecordFileName ((.service) workspace)+            legacyFragmentPath = out </> legacyWorkspaceManifestFileName ((.service) workspace)+        renameFile recordPath legacyRecordPath+        renameFile currentFragment legacyFragmentPath+        beforeMigration <- treeSnapshot out+        refused <- executeWorkspaceScaffoldWithNameMigrations out False False plan+        refused `shouldSatisfy` \case+          Left [SidecarMigrationRequired sidecars, GeneratedHaskellEditionRequired impact] ->+            length sidecars == 2 && (.fromEdition) impact == LegacyNamingV1+          _ -> False+        treeSnapshot out `shouldReturn` beforeMigration+        nameOnly <- executeWorkspaceScaffoldWithMigrations out False True False plan+        nameOnly `shouldSatisfy` \case+          Left [NameMigrationRequired moves, GeneratedHaskellEditionRequired impact, SidecarMovesAlreadyApplied sidecars] ->+            length moves == length selectedRows+              && (.fromEdition) impact == LegacyNamingV1+              && length sidecars == 2+          _ -> False+        applied <- executeWorkspaceScaffoldWithMigrations out False True True plan+        report <- case applied of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right value -> pure value+        length ((.nameMoves) report) `shouldBe` length selectedRows+        let editionBackupRoot = out </> ".keiro-dsl-generated-haskell-migrations/legacy-v1-to-idiomatic-v2"+        doesFileExist (editionBackupRoot </> workspaceRecordFileName ((.service) workspace)) `shouldReturn` True+        doesFileExist (editionBackupRoot </> workspaceManifestFileName ((.service) workspace)) `shouldReturn` True+        remediation <- TIO.readFile (editionBackupRoot </> "remediation-report.txt")+        remediation `shouldSatisfy` T.isInfixOf ("source-moves: " <> T.pack (show (length selectedRows)))+        migratedRecord <-+          TIO.readFile recordPath >>= \contents ->+            maybe (expectationFailure "migrated workspace record did not parse" >> fail "unreachable") pure (parseWorkspaceRecord contents)+        (.namingEdition) migratedRecord `shouldBe` IdiomaticNamingV2+        let migratedRows = [row | row <- (.modules) migratedRecord, (.role) row `Map.member` ownersBefore]+        Map.fromList [((.role) row, (.owner) row) | row <- migratedRows] `shouldBe` ownersBefore+        map (.path) migratedRows `shouldSatisfy` all (not . T.isInfixOf "Project_activity" . T.pack)+        forM_ selectedRows $ \row -> do+          doesFileExist (out </> legacyPath ((.path) row)) `shouldReturn` False+          doesFileExist (out </> (.path) row) `shouldReturn` True+          doesFileExist (out </> ".keiro-dsl-name-migrations/legacy-v1-to-idiomatic-v1" </> legacyPath ((.path) row)) `shouldReturn` True++  describe "generated Haskell edition migration" $ do+    it "refuses without mutation and adopts idiomatic-v2 with durable backups while preserving Hole bytes" $+      withTempDirectory "keiro-dsl-generated-haskell-edition" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            sourceLanguage = (.sourceLanguage) parsed+        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)+        let runAt applyEdition =+              executeServiceScaffoldWithRuntimePackageAndMigrations+                Nothing+                False+                applyEdition+                out+                False+                "behavior-complete.keiro"+                sourceLanguage+                ctx+                service+                modules+        _ <- runAt False >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        let recordPath = out </> recordFileName (spec.context)+            backupRoot = out </> ".keiro-dsl-generated-haskell-migrations/legacy-v1-to-idiomatic-v2"+        currentRecord <-+          TIO.readFile recordPath >>= \contents ->+            maybe (expectationFailure "fresh scaffold record did not parse" >> fail "unreachable") pure (parseRecord contents)+        let legacyRecord = scaffoldRecordWithEdition LegacyNamingV1 currentRecord+            behaviorHole =+              head+                [ out </> (.path) scaffoldModule+                | scaffoldModule <- modules,+                  (.kind) scaffoldModule == HoleStub,+                  "BehaviorHoles.hs" `T.isSuffixOf` T.pack ((.path) scaffoldModule)+                ]+        TIO.writeFile recordPath (renderRecord legacyRecord)+        originalHole <- TIO.readFile behaviorHole+        let legacyHole =+              originalHole+                <> T.unlines+                  [ "",+                    "editionMigrationPrefix f = failureCode f",+                    "editionMigrationQualified f = BC.failureCode f",+                    "editionMigrationDot f = f.failureCode",+                    "editionMigrationField f = f {failureCode = \"x\"}",+                    "editionMigrationOperator fs = failureCode <$> fs",+                    "-- failureCode f",+                    "editionMigrationCurrent f = f.code"+                  ]+        TIO.writeFile behaviorHole legacyHole+        beforeRefusal <- treeSnapshot out+        refused <- runAt False+        refused `shouldSatisfy` \case+          Left [GeneratedHaskellEditionRequired impact] ->+            (.fromEdition) impact == LegacyNamingV1+              && not (null ((.generatedPaths) impact))+              && length ((.sidecarPaths) impact) == 2+              && Set.fromList [((.current) use, (.form) use) | use <- (.handOwnedUses) impact]+                == Set.fromList+                  [ ("failureCode", PrefixApplication),+                    ("failureCode", QualifiedApplication),+                    ("failureCode", RecordDotRenamed),+                    ("failureCode", RecordFieldBinding),+                    ("failureCode", OperatorOperand)+                  ]+          _ -> False+        renderRefusals (either id (const []) refused)+          `shouldSatisfy` \lines' ->+            any (T.isInfixOf "--apply-generated-haskell-edition") lines'+              && any (T.isInfixOf "legacy-v1 -> idiomatic-v2") lines'+        treeSnapshot out `shouldReturn` beforeRefusal++        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        TIO.readFile behaviorHole `shouldReturn` legacyHole+        backupRecord <- TIO.readFile (backupRoot </> recordFileName (spec.context))+        backupRecord `shouldSatisfy` T.isInfixOf "naming-edition legacy-v1"+        adoptedRecord <- TIO.readFile recordPath+        adoptedRecord `shouldSatisfy` T.isInfixOf "naming-edition idiomatic-v2"+        remediation <- TIO.readFile (backupRoot </> "remediation-report.txt")+        remediation `shouldSatisfy` T.isInfixOf "failureCode (PrefixApplication) -> record.code"+        remediation `shouldSatisfy` T.isInfixOf "attributable uses only"++        backedUpFiles <- treeSnapshot backupRoot+        forM_ backedUpFiles $ \(path, contents) ->+          unless (path == "remediation-report.txt") (writeFileWithParents (out </> path) contents)+        TIO.writeFile behaviorHole originalHole+        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        refreshedRemediation <- TIO.readFile (backupRoot </> "remediation-report.txt")+        refreshedRemediation `shouldSatisfy` T.isInfixOf "hand-owned-selector-uses: 0"+        rerun <- runAt False+        case rerun of+          Left failures -> expectationFailure (show failures)+          Right _ -> pure ()+    it "uses the same refusal and backup protocol for a workspace ledger" $+      withTempDirectory "keiro-dsl-workspace-generated-haskell-edition" $ \out -> do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        plan <- shouldPlanWorkspaceSpec workspace+        _ <- executeWorkspaceScaffold out False plan >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        let recordPath = out </> workspaceRecordFileName ((.service) workspace)+            backupRecord =+              out+                </> ".keiro-dsl-generated-haskell-migrations/legacy-v1-to-idiomatic-v2"+                </> workspaceRecordFileName ((.service) workspace)+        currentRecord <- TIO.readFile recordPath+        TIO.writeFile recordPath (T.unlines (filter (not . T.isPrefixOf "naming-edition ") (T.lines currentRecord)))+        beforeRefusal <- treeSnapshot out+        refused <- executeWorkspaceScaffoldWithMigrations out False False False plan+        refused `shouldSatisfy` \case+          Left [GeneratedHaskellEditionRequired impact] ->+            (.fromEdition) impact == LegacyNamingV1 && not (null ((.generatedPaths) impact))+          _ -> False+        treeSnapshot out `shouldReturn` beforeRefusal+        _ <- executeWorkspaceScaffoldWithMigrations out False False True plan >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        backedUp <- TIO.readFile backupRecord+        backedUp `shouldSatisfy` (not . T.isInfixOf "naming-edition ")+        adopted <- TIO.readFile recordPath+        adopted `shouldSatisfy` T.isInfixOf "naming-edition idiomatic-v2"+    it "refuses an unreadable single-spec ledger without changing the tree" $+      withTempDirectory "keiro-dsl-unreadable-ledger" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            sourceLanguage = (.sourceLanguage) parsed+        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)+        let run =+              executeServiceScaffoldWithRuntimePackageAndMigrations+                Nothing+                False+                False+                out+                False+                "behavior-complete.keiro"+                sourceLanguage+                ctx+                service+                modules+            recordPath = out </> recordFileName (spec.context)+        _ <- run >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        TIO.appendFile recordPath "spec: duplicate.keiro\n"+        before <- treeSnapshot out+        run `shouldReturn` Left [LedgerUnreadable recordPath]+        treeSnapshot out `shouldReturn` before+    it "refuses an unreadable workspace ledger without changing the tree" $+      withTempDirectory "keiro-dsl-workspace-unreadable-ledger" $ \out -> do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        plan <- shouldPlanWorkspaceSpec workspace+        _ <- executeWorkspaceScaffold out False plan >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        let recordPath = out </> workspaceRecordFileName ((.service) workspace)+        TIO.appendFile recordPath "service: duplicate\n"+        before <- treeSnapshot out+        executeWorkspaceScaffoldWithMigrations out False False False plan+          `shouldReturn` Left [LedgerUnreadable recordPath]+        treeSnapshot out `shouldReturn` before+    it "refuses a tampered edition backup without changing the tree" $+      withTempDirectory "keiro-dsl-tampered-edition-backup" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            sourceLanguage = (.sourceLanguage) parsed+        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)+        let runAt applyEdition =+              executeServiceScaffoldWithRuntimePackageAndMigrations Nothing False applyEdition out False "behavior-complete.keiro" sourceLanguage ctx service modules+            recordPath = out </> recordFileName (spec.context)+            backupRoot = out </> ".keiro-dsl-generated-haskell-migrations/idiomatic-v1-to-idiomatic-v2"+        _ <- runAt False >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        currentRecord <- TIO.readFile recordPath >>= maybe (fail "fresh record did not parse") pure . parseRecord+        TIO.writeFile recordPath (renderRecord (scaffoldRecordWithEdition IdiomaticNamingV1 currentRecord))+        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        backedUpFiles <- treeSnapshot backupRoot+        forM_ backedUpFiles $ \(path, contents) ->+          unless (path == "remediation-report.txt") (writeFileWithParents (out </> path) contents)+        let generatedBackup =+              head [path | (path, _) <- backedUpFiles, takeExtension path == ".hs"]+        TIO.appendFile (backupRoot </> generatedBackup) "\n-- tampered\n"+        beforeRefusal <- treeSnapshot out+        refused <- runAt True+        refused `shouldSatisfy` \case+          Left [GeneratedHaskellEditionRefusal [reason]] -> T.pack generatedBackup `T.isInfixOf` reason+          _ -> False+        treeSnapshot out `shouldReturn` beforeRefusal+    it "detects an interrupted apply while the ledger is pre-current and recovers after restoring backups" $+      withTempDirectory "keiro-dsl-interrupted-edition-apply" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            sourceLanguage = (.sourceLanguage) parsed+        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)+        let runAt applyEdition =+              executeServiceScaffoldWithRuntimePackageAndMigrations Nothing False applyEdition out False "behavior-complete.keiro" sourceLanguage ctx service modules+            recordRelative = recordFileName (spec.context)+            recordPath = out </> recordRelative+            backupRoot = out </> ".keiro-dsl-generated-haskell-migrations/idiomatic-v1-to-idiomatic-v2"+        _ <- runAt False >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        currentRecord <- TIO.readFile recordPath >>= maybe (fail "fresh record did not parse") pure . parseRecord+        TIO.writeFile recordPath (renderRecord (scaffoldRecordWithEdition IdiomaticNamingV1 currentRecord))+        forM_ [out </> path | (Generated, path) <- (.files) currentRecord] $ \path ->+          TIO.appendFile path "\n-- pre-adoption edition bytes\n"+        initialRefusal <- runAt False+        generatedCount <- case initialRefusal of+          Left [GeneratedHaskellEditionRequired impact] -> pure (length ((.generatedPaths) impact))+          other -> expectationFailure (show other) >> fail "unreachable"+        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        cleanApply <- treeSnapshot out+        -- Conflict detection is active only while the ledger records a+        -- pre-current edition; restoring just that ledger models interruption.+        TIO.readFile (backupRoot </> recordRelative) >>= TIO.writeFile recordPath+        interrupted <- runAt True+        interrupted `shouldSatisfy` \case+          Left [GeneratedHaskellEditionRefusal reasons] ->+            length reasons == generatedCount && all (T.isInfixOf "edition backup conflict") reasons+          _ -> False+        backedUpFiles <- treeSnapshot backupRoot+        forM_ backedUpFiles $ \(path, contents) ->+          unless (path == "remediation-report.txt") (writeFileWithParents (out </> path) contents)+        _ <- runAt True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        treeSnapshot out `shouldReturn` cleanApply+    it "drives the built CLI through refusal, apply, and idempotent rerun" $+      withTempDirectory "keiro-dsl-edition-cli" $ \out -> do+        let fixture = "test/fixtures/behavior-complete.keiro"+        (initialCode, _, _) <- runKeiroDsl ["scaffold", fixture, "--out", out]+        initialCode `shouldBe` ExitSuccess+        spec <- specOf fixture+        let recordPath = out </> recordFileName (spec.context)+        currentRecord <- TIO.readFile recordPath+        TIO.writeFile recordPath (T.replace "naming-edition idiomatic-v2" "naming-edition idiomatic-v1" currentRecord)+        beforeRefusal <- treeSnapshot out+        (refusalCode, _, refusalError) <- runKeiroDsl ["scaffold", fixture, "--out", out]+        refusalCode `shouldBe` ExitFailure 1+        refusalError `shouldSatisfy` isInfixOf "generated Haskell edition migration required: idiomatic-v1 -> idiomatic-v2"+        treeSnapshot out `shouldReturn` beforeRefusal+        (applyCode, _, _) <- runKeiroDsl ["scaffold", fixture, "--out", out, "--apply-generated-haskell-edition"]+        applyCode `shouldBe` ExitSuccess+        afterApply <- treeSnapshot out+        (rerunCode, _, _) <- runKeiroDsl ["scaffold", fixture, "--out", out, "--apply-generated-haskell-edition"]+        rerunCode `shouldBe` ExitSuccess+        treeSnapshot out `shouldReturn` afterApply++  describe "generated Haskell presentation rewrite" $ do+    it "keeps Template Haskell quotes and promoted ticks in Code" $ do+      modernizeGeneratedHaskellSourceWithState "x = ''Foo\ny = sourceFile r\n"+        `shouldBe` ("x = ''Foo\ny = file r\n", Code)+      modernizeGeneratedHaskellSourceWithState "x = '[]\ny = sourceFile r\n"+        `shouldBe` ("x = '[]\ny = file r\n", Code)+      modernizeGeneratedHaskellSourceWithState "x = a --> sourceFile r\n"+        `shouldBe` ("x = a --> file r\n", Code)+    it "finishes every tracked Generated module in Code" $ do+      testTree <- treeSnapshot "test"+      let generatedSources = [(path, source) | (path, source) <- testTree, "/Generated/" `isInfixOf` ("/" <> path)]+      generatedSources `shouldSatisfy` (not . null)+      forM_ generatedSources $ \(path, source) -> do+        let (_, finalState) = modernizeGeneratedHaskellSourceWithState source+        unless (finalState == Code) (expectationFailure (path <> " ended in " <> show finalState))++  describe "sidecar migration (EP-198)" $ do+    it "refuses old context names, applies lossless moves, preserves stale history, and is idempotent" $+      withTempDirectory "keiro-dsl-sidecar-migration" $ \base -> do+        parsed <- parsedSourceOf "test/fixtures/reservation.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            sourceLanguage = (.sourceLanguage) parsed+            plain = base </> "plain"+            migrated = base </> "migrated"+            runAt out apply specPath selected =+              executeServiceScaffoldWithRuntimePackageAndNameMigrations+                Nothing+                apply+                out+                False+                specPath+                sourceLanguage+                ctx+                service+                selected+        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)+        _ <- runAt plain False "reservation.keiro" modules >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        _ <- runAt migrated False "reservation.keiro" modules >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        let reduced = drop 1 modules+            currentLedger = contextLedgerFileName (spec.context)+            currentFragment = contextCabalFragmentFileName (spec.context)+            oldLedger = legacyContextRecordFileName (spec.context)+            oldFragment = legacyContextManifestFileName (spec.context)+        renameFile (migrated </> currentLedger) (migrated </> oldLedger)+        renameFile (migrated </> currentFragment) (migrated </> oldFragment)+        treeBefore <- treeSnapshot migrated+        refused <- runAt migrated False "reservation-reduced.keiro" reduced+        refused `shouldSatisfy` \case+          Left [SidecarMigrationRequired moves] ->+            length moves == 2+              && all ((== RenameSidecar) . (.moveDisposition)) moves+          _ -> False+        renderRefusals (either id (const []) refused)+          `shouldSatisfy` any (T.isInfixOf "--apply-name-migrations")+        treeSnapshot migrated `shouldReturn` treeBefore++        baseline <- runAt plain False "reservation-reduced.keiro" reduced >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        applied <- runAt migrated True "reservation-reduced.keiro" reduced >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        map (.moveDisposition) ((.sidecarMoves) applied) `shouldBe` [RenameSidecar, RenameSidecar]+        (.stale) applied `shouldBe` (.stale) baseline+        (.previousSpecPath) applied `shouldBe` Just "reservation.keiro"+        doesFileExist (migrated </> oldLedger) `shouldReturn` False+        doesFileExist (migrated </> oldFragment) `shouldReturn` False+        doesFileExist (migrated </> currentLedger) `shouldReturn` True+        doesFileExist (migrated </> currentFragment) `shouldReturn` True++        rerun <- runAt migrated True "reservation-reduced.keiro" reduced >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        (.sidecarMoves) rerun `shouldBe` []++        let duplicateBytes = "legacy duplicate cabal fragment\n"+            backup = migrated </> ".keiro-dsl-name-migrations/sidecar-v1" </> oldFragment+        TIO.writeFile (migrated </> oldFragment) duplicateBytes+        duplicateRefusal <- runAt migrated False "reservation-reduced.keiro" reduced+        duplicateRefusal `shouldSatisfy` \case+          Left [SidecarMigrationRequired [move]] -> (.moveDisposition) move == RetireLegacySidecar+          _ -> False+        retired <- runAt migrated True "reservation-reduced.keiro" reduced >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        map (.moveDisposition) ((.sidecarMoves) retired) `shouldBe` [RetireLegacySidecar]+        doesFileExist (migrated </> oldFragment) `shouldReturn` False+        TIO.readFile backup `shouldReturn` duplicateBytes++  describe "Haskell.name-diff" $ do+    it "classifies a workqueue payload type rename only on consumer-build" $ do+      base <- specOf "test/fixtures/reservation-work.keiro"+      let renamed = mapWorkqueue (workqueueWithPayloadName "ReservationJob") base+          findings = generatedHaskellNameFindings (diffSpecs base renamed)+      case findings of+        [finding] -> assertGeneratedHaskellNameFinding finding+        values -> expectationFailure ("expected one payload-name finding, got " <> show (length values))+      let workspaceFindings =+            generatedHaskellNameFindings+              (map (.change) (diffWorkspaces (oneMemberWorkspace "queue.keiro" base) (oneMemberWorkspace "queue.keiro" renamed)))+      workspaceFindings `shouldSatisfy` \case [finding] -> isAdvisory finding; _ -> False+      replayImpactSpecs base renamed `shouldBe` ReplayNeutral+    it "pairs a mapped selector rename by unchanged wire key and keeps fold identity stable" $ do+      source <- readTestText "test/fixtures/consumer-types.keiro"+      base <- parseInlineSpec "<mapped-selector-old>" source+      renamed <-+        parseInlineSpec+          "<mapped-selector-new>"+          (T.replace "key         as \"key\"" "artifactKey as \"key\"" source)+      let findings = generatedHaskellNameFindings (diffSpecs base renamed)+      case findings of+        [finding] -> do+          assertGeneratedHaskellNameFinding finding+          (.subject) (kindOfChange finding) `shouldSatisfy` T.isInfixOf "artifactKey"+        values -> expectationFailure ("expected one selector-name finding, got " <> show (length values))+      replayImpactSpecs base renamed `shouldBe` ReplayNeutral+      legacyAggregateFoldFingerprint base (onlyAggregate base)+        `shouldBe` legacyAggregateFoldFingerprint renamed (onlyAggregate renamed)+    it "pairs a workqueue module rename by unchanged explicit runtime facts" $ do+      base <- specOf "test/fixtures/reservation-work.keiro"+      let queueOnly = specWithNodes [node | node@NWorkqueue {} <- base.nodes] base+          renamed = mapWorkqueue (workqueueWithName "reservation_jobs") queueOnly+          findings = generatedHaskellNameFindings (diffSpecs queueOnly renamed)+      case findings of+        [finding] -> do+          assertGeneratedHaskellNameFinding finding+          (.facet) (kindOfChange finding) `shouldBe` "workqueue-module"+        values -> expectationFailure ("expected one module-name finding, got " <> show (length values))+      map ((.code) . kindOfChange) (diffSpecs queueOnly renamed) `shouldNotContain` [QueueIdentityChanged]+      replayImpactSpecs queueOnly renamed `shouldBe` ReplayNeutral+    it "emits no finding when edited logical spellings normalize identically" $ do+      base <- specOf "test/fixtures/reservation-work.keiro"+      let queueOnly = specWithNodes [node | node@NWorkqueue {} <- base.nodes] base+          recased = mapWorkqueue (workqueueWithName "reservationWork") queueOnly+      generatedHaskellNameFindings (diffSpecs queueOnly recased) `shouldBe` []++  describe "canonical reservation.keiro" $+    it "parses into the expected aggregate shape" $ do+      input <- readTestText "test/fixtures/reservation.keiro"+      case parseSpec "test/fixtures/reservation.keiro" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> do+          spec.context `shouldBe` "hospital-capacity"+          length ((.ids) spec) `shouldBe` 3+          length ((.enums) spec) `shouldBe` 3+          length ((.rules) spec) `shouldBe` 1+          case (.nodes) spec of+            [NAggregate a] -> do+              (.name) a `shouldBe` "Reservation"+              length ((.states) a) `shouldBe` 6+              length ((.commands) a) `shouldBe` 2+              length ((.events) a) `shouldBe` 2+              length ((.transitions) a) `shouldBe` 2+              map (.terminal) ((.states) a) `shouldBe` [False, False, False, True, True, True]+            other -> expectationFailure ("expected one aggregate node, got " <> show (length other))++  describe "validator" $ do+    it "accepts the canonical reservation.keiro" $ do+      codes <- errorCodesOf "test/fixtures/reservation.keiro"+      codes `shouldBe` []+    it "keeps unrelated aggregate-only specs free of inert-surface warnings" $ do+      codes <- diagnosticCodesOf "test/fixtures/reservation.keiro"+      codes+        `shouldNotContain` [ IntakeBindFlagUnenforced,+                             RmInlineSubscriptionIgnored+                           ]+    it "reports empty aggregates at their declaration under legacy and stable contracts" $ do+      spec <- specOf "test/fixtures/reservation.keiro"+      case [aggregate | NAggregate aggregate <- (.nodes) spec] of+        aggregate : _ -> do+          let emptyAggregate = aggregateWithCommandsEventsTransitions [] [] [] aggregate+              emptySpec = specWithNodes [NAggregate emptyAggregate] spec+              expectedLine = unLoc ((.loc) aggregate)+              planningCodes = [GeneratedPathCollision, GeneratedImportCycle, BehaviorDerivationInvalid, ConformanceFactKeyCollision, GeneratedPlanningInvariantViolation]+              expectedMessage =+                "aggregate 'Reservation' declares no commands, no events, and no transitions; scaffold cannot lower an empty aggregate -- declare at least one command, one event, and one transition"+          forM_ [legacyCheckedService emptySpec, stableCheckedService emptySpec] $ \service -> do+            let diagnostics = checkTestServiceDiagnostics Nothing (defaultContext (emptySpec.context)) service+            [ ((.severity) diagnostic, (.line) diagnostic, (.message) diagnostic)+              | diagnostic <- diagnostics,+                (.code) diagnostic == AggregateEmpty+              ]+              `shouldBe` [(Error, expectedLine, expectedMessage)]+            filter (`elem` planningCodes) (map (.code) diagnostics) `shouldBe` []+          scaffoldRefusals emptySpec `shouldSatisfy` any (T.isPrefixOf "AggregateEmpty:")+        [] -> expectationFailure "reservation fixture has no aggregate"+    it "reports empty contracts at their declaration under legacy and stable contracts" $ do+      spec <- specOf "test/fixtures/contract-v4.keiro"+      case [contract | NContract contract <- (.nodes) spec] of+        contract : _ -> do+          let emptyContract = contractNodeWithEvents [] contract+              emptySpec = specWithNodes [NContract emptyContract] spec+              expectedLine = unLoc ((.loc) contract)+              planningCodes = [GeneratedPathCollision, GeneratedImportCycle, BehaviorDerivationInvalid, ConformanceFactKeyCollision, GeneratedPlanningInvariantViolation]+              expectedMessage =+                "contract 'emergency' declares no events; scaffold cannot lower an empty contract -- declare at least one event"+          forM_ [legacyCheckedService emptySpec, stableCheckedService emptySpec] $ \service -> do+            let diagnostics = checkTestServiceDiagnostics Nothing (defaultContext (emptySpec.context)) service+            [ ((.severity) diagnostic, (.line) diagnostic, (.message) diagnostic)+              | diagnostic <- diagnostics,+                (.code) diagnostic == ContractEmpty+              ]+              `shouldBe` [(Error, expectedLine, expectedMessage)]+            filter (`elem` planningCodes) (map (.code) diagnostics) `shouldBe` []+          scaffoldRefusals emptySpec `shouldSatisfy` any (T.isPrefixOf "ContractEmpty:")+        [] -> expectationFailure "contract fixture has no contract"+    it "keeps a check-time error counterpart for every sampled lowering refusal class" $ do+      emitSource <- readTestText "test/fixtures/emit.keiro"+      incompleteBackoff <- parseInlineSpec "<incomplete-backoff-parity>" (T.replace "backoff constant 2s" "backoff exponential 2s" emitSource)+      baseAggregate <- parseInlineSpec "<lowering-parity>" loweringAggregateSpec+      bareTextInitial <- parseInlineSpec "<bare-text-initial-parity>" (T.replace "\"hello world\"" "hello" loweringAggregateSpec)+      unsupportedField <- parseInlineSpec "<unsupported-field-parity>" (T.replace "count:Int" "count:Json" loweringAggregateSpec)+      mappedInitial <- specOf "test/fixtures/mapped-missing-initial.keiro"+      let candidates =+            [ ("incomplete publisher backoff", incompleteBackoff),+              ("invalid register initial", bareTextInitial),+              ("unrepresentable aggregate field", unsupportedField),+              ("missing mapped register initial", mappedInitial)+            ]+      scaffoldRefusals baseAggregate `shouldBe` []+      forM_ candidates $ \(caseLabel, candidate) ->+        unless+          (not (null (scaffoldRefusals candidate)) && any ((== Error) . (.severity)) (validateSpec candidate))+          (expectationFailure (caseLabel <> " did not fail at both check and scaffold planning"))+    it "rejects policy words that generated Haskell cannot lower" $ do+      emitSpec <- specOf "test/fixtures/emit.keiro"+      intakeSpec <- specOf "test/fixtures/intake.keiro"+      let unknownOrdering = mapPublisher (publisherWithOrdering "banana") emitSpec+          unknownBackoff =+            mapPublisher+              (\publisher -> publisherWithBackoff (backoffWithKind "banana" publisher.backoff) publisher)+              emitSpec+          incompleteBackoff =+            mapPublisher+              (publisherWithBackoff (BackoffSpec "exponential" "2s" Nothing Nothing))+              emitSpec+          unknownDedupe = mapIntake (intakeWithDedupePolicy "Banana") intakeSpec+      errorCodes unknownOrdering `shouldContain` [PublisherOrderingUnknown]+      errorCodes unknownBackoff `shouldContain` [PublisherBackoffInvalid]+      errorCodes incompleteBackoff `shouldContain` [PublisherBackoffInvalid]+      errorCodes unknownDedupe `shouldContain` [IntakeDedupePolicyUnknown]+    it "gates numeric floors on the published stable language-4 contract" $ do+      emitSpec <- specOf "test/fixtures/emit.keiro"+      intakeSpec <- specOf "test/fixtures/intake.keiro"+      readModelSpec <- specOf "test/fixtures/workflow.keiro"+      let zeroContract = mapContract (contractWithSchemaVersion 0) emitSpec+          zeroAttempts = mapPublisher (publisherWithMaxAttempts 0) emitSpec+          zeroDecode = mapIntake (\intake -> intakeWithDecode (decodeWithBodySchemaVersion 0 intake.decode) intake) intakeSpec+          zeroReadModel = modifyReadModel "transferDecision" (readModelWithVersion 0) readModelSpec+          floors =+            [ (zeroContract, ContractSchemaVersionBelowMinimum),+              (zeroAttempts, PublisherMaxAttemptsBelowMinimum),+              (zeroDecode, IntakeDecodeSchemaVersionBelowMinimum),+              (zeroReadModel, ReadModelVersionBelowMinimum)+            ]+      forM_ floors $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldNotContain` [expected]+        serviceErrorCodes 4 candidate `shouldContain` [expected]+    it "rejects duplicate declarations whose generated behavior cannot work" $ do+      reservation <- specOf "test/fixtures/reservation.keiro"+      integration <- specOf "test/fixtures/emit.keiro"+      let duplicateCommandField =+            modifyAggregate+              "Reservation"+              (\aggregate -> aggregateWithCommands (updateFirst (\command -> commandWithFields (duplicateFirst command.fields) command) aggregate.commands) aggregate)+              reservation+          duplicateState = modifyAggregate "Reservation" (\aggregate -> aggregateWithStates (duplicateFirst aggregate.states) aggregate) reservation+          duplicateTransition =+            modifyAggregate+              "Reservation"+              (\aggregate -> aggregateWithTransitions (aggregate.transitions <> take 1 (reverse aggregate.transitions)) aggregate)+              reservation+          duplicateContractField =+            mapContract+              (\contract -> contractNodeWithEvents (updateFirst (\event -> contractEventWithFields (duplicateFirst event.fields) event) contract.events) contract)+              integration+          duplicateContractEvent = mapContract (\contract -> contractNodeWithEvents (duplicateFirst contract.events) contract) integration+          duplicateTopicAlias = mapContract (\contract -> contractWithTopics (duplicateFirst contract.topics) contract) integration+          cases =+            [ (duplicateCommandField, AggregateDuplicateFieldName),+              (duplicateState, AggregateDuplicateState),+              (duplicateTransition, TransitionDuplicateUnguarded),+              (duplicateContractField, ContractDuplicateFieldName),+              (duplicateContractEvent, ContractDuplicateEvent),+              (duplicateTopicAlias, ContractDuplicateTopicAlias)+            ]+      forM_ cases $ \(candidate, expected) -> errorCodes candidate `shouldContain` [expected]+    it "gates ambiguous and silently shadowed duplicate surfaces on language 4" $ do+      reservation <- specOf "test/fixtures/reservation.keiro"+      integration <- specOf "test/fixtures/emit.keiro"+      let duplicateRegister = modifyAggregate "Reservation" (\aggregate -> aggregateWithRegs (duplicateFirst aggregate.regs) aggregate) reservation+          duplicateNominal = specWithIds (duplicateFirst reservation.ids) reservation+          duplicateMap = mapEmit (\emitNode -> emitNodeWithMap (duplicateFirst emitNode.map) emitNode) integration+          shadowDiscriminator =+            mapContract+              ( \contract ->+                  contractNodeWithEvents+                    ( updateFirst+                        (\event -> contractEventWithFields (updateFirst (contractFieldWithName contract.discriminator) event.fields) event)+                        contract.events+                    )+                    contract+              )+              integration+          guardedSibling =+            modifyAggregate+              "Reservation"+              ( \aggregate ->+                  aggregateWithTransitions+                    (aggregate.transitions <> [transitionWithGuard (Just (EAtom (ABool True))) transition | transition <- take 1 (reverse aggregate.transitions)])+                    aggregate+              )+              reservation+          cases =+            [ (duplicateRegister, AggregateDuplicateRegister),+              (duplicateNominal, NominalDuplicateDeclaration),+              (duplicateMap, EmitMapDuplicateCase),+              (shadowDiscriminator, ContractFieldShadowsDiscriminator),+              (guardedSibling, TransitionUnguardedSibling)+            ]+      forM_ cases $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldNotContain` [expected]+        serviceErrorCodes 4 candidate `shouldContain` [expected]+    it "gates stable identities and external names on language 4" $ do+      workflowSpec <- specOf "test/fixtures/workflow.keiro"+      processSpec <- specOf "test/fixtures/surge-service.keiro"+      routerSpec <- specOf "test/fixtures/transfer-routing.keiro"+      integration <- specOf "test/fixtures/emit.keiro"+      let invalidIdentity = mapWorkflow (workflowWithStable "") workflowSpec+          duplicateIdentity =+            specWithNodes+              ( processSpec.nodes+                  <> [NRouter (routerWithName "surge-demo" router) | NRouter router <- routerSpec.nodes]+              )+              processSpec+          invalidTopic = mapContract (\contract -> contractWithTopics [(alias, "bad topic") | (alias, _) <- contract.topics] contract) integration+          emptyTopic = mapContract (\contract -> contractWithTopics [(alias, "") | (alias, _) <- contract.topics] contract) integration+          invalidReadModel = modifyReadModel "transferDecision" (readModelWithTable "Bad-Table") workflowSpec+          duplicateColumn = modifyReadModel "transferDecision" (\readModel -> readModelWithColumns (duplicateFirst readModel.columns) readModel) workflowSpec+          gatedCases =+            [ (invalidIdentity, RuntimeIdentityInvalid),+              (duplicateIdentity, RuntimeIdentityDuplicate),+              (invalidTopic, ContractTopicNameInvalid),+              (invalidReadModel, ReadModelIdentifierInvalid),+              (duplicateColumn, ReadModelDuplicateColumn)+            ]+      forM_ gatedCases $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldNotContain` [expected]+        serviceErrorCodes 4 candidate `shouldContain` [expected]+      serviceErrorCodes 3 emptyTopic `shouldContain` [ContractTopicNameInvalid]+      serviceErrorCodes 4 emptyTopic `shouldContain` [ContractTopicNameInvalid]+    it "gates declared integration and wire couplings on language 4" $ do+      intakeSpec <- specOf "test/fixtures/intake.keiro"+      reservation <- specOf "test/fixtures/reservation.keiro"+      let unresolvedBind =+            mapIntake+              (\intake -> intakeWithBinds (updateFirst (bindRowWithField "ghost") intake.binds) intake)+              intakeSpec+          acceptedEventBind =+            mapIntake+              (\intake -> intakeWithBinds (updateFirst (bindRowWithField "region") intake.binds) intake)+              intakeSpec+          unresolvedDedupe = mapIntake (intakeWithDedupeKey "ghost") intakeSpec+          unknownEnvelope = mapIntake (\intake -> intakeWithDecode (decodeWithEnvelope "banana policy" intake.decode) intake) intakeSpec+          mismatchedSchema = mapIntake (\intake -> intakeWithDecode (decodeWithBodySchemaVersion 2 intake.decode) intake) intakeSpec+          unresolvedAlias =+            mapContract+              (\contract -> contractNodeWithEvents (updateFirst (contractEventWithTopic "ghost") contract.events) contract)+              intakeSpec+          unsupportedWire =+            modifyAggregate+              "Reservation"+              (\aggregate -> aggregateWithWire (fmap (wireSpecWithKind "banana") aggregate.wire) aggregate)+              reservation+          cases =+            [ (unresolvedBind, IntakeBindUnresolved),+              (unresolvedDedupe, IntakeDedupeKeyUnresolved),+              (unknownEnvelope, IntakeEnvelopePolicyUnknown),+              (mismatchedSchema, IntakeDecodeSchemaVersionMismatch),+              (unresolvedAlias, ContractTopicAliasUnresolved),+              (unsupportedWire, WireClauseUnsupported)+            ]+      forM_ cases $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldNotContain` [expected]+        serviceErrorCodes 4 candidate `shouldContain` [expected]+      serviceErrorCodes 4 acceptedEventBind `shouldNotContain` [IntakeBindUnresolved]+    it "gates closed workqueue vocabularies and bounded windows on language 4" $ do+      queueSpec <- specOf "test/fixtures/reservation-work.keiro"+      intakeSpec <- specOf "test/fixtures/intake.keiro"+      emitSpec <- specOf "test/fixtures/emit.keiro"+      processSpec <- specOf "test/fixtures/hospital-surge.keiro"+      let huge = "18446744073709551618s"+          unknownPayload =+            mapWorkqueue+              (\queue -> workqueueWithPayload [if field.name == "hospitalId" then wqFieldWithValueType (LegacyQueueScalar (QueueOther "numeric")) field else field | field <- queue.payload] queue)+              queueSpec+          queueDelay = mapWorkqueue (workqueueWithDelay huge) queueSpec+          queueRetry = mapWorkqueue (\queue -> workqueueWithDisposition (updateFirst (wqDispRowWithAction (IRetry huge)) queue.disposition) queue) queueSpec+          intakeRetry = mapIntake (\intake -> intakeWithDisposition (updateFirst (dispositionRowWithAction (IRetry huge)) intake.disposition) intake) intakeSpec+          publisherBackoff = mapPublisher (\publisher -> publisherWithBackoff (backoffWithWindow huge publisher.backoff) publisher) emitSpec+          publisherMaximum =+            mapPublisher+              (\publisher -> publisherWithBackoff (BackoffSpec "exponential" publisher.backoff.window (Just huge) (Just "2")) publisher)+              emitSpec+          processFireAt =+            modifyProcess+              "HospitalSurge"+              (\process -> let timer = legacyProcessTimer process in processWithTimer (timerWithFireAt (fireAtWithWindow huge timer.fireAt) timer) process)+              processSpec+          cases =+            [ (unknownPayload, WqPayloadTypeUnknown),+              (queueDelay, WindowOutOfRange),+              (queueRetry, WindowOutOfRange),+              (intakeRetry, WindowOutOfRange),+              (publisherBackoff, WindowOutOfRange),+              (publisherMaximum, WindowOutOfRange),+              (processFireAt, WindowOutOfRange)+            ]+      forM_ cases $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldBe` []+        serviceErrorCodes 4 candidate `shouldContain` [expected]+    -- ExecPlan 199: spellings the grammar accepted that no runtime implements.+    -- Each pair asserts both halves of the contract — the divergent spelling+    -- warns at 3 and errors at 4, and the spelling that matches the runtime+    -- stays completely silent, so these are refusals and not blanket noise.+    it "refuses spec surfaces that contradict the runtime, and stays silent on the ones that describe it" $ do+      intakeSpec <- specOf "test/fixtures/intake.keiro"+      processSpec <- specOf "test/fixtures/hospital-surge.keiro"+      routerSpec <- specOf "test/fixtures/transfer-routing.keiro"+      let lenientBody =+            mapIntake (\intake -> intakeWithDecode (decodeWithBodyStrict False intake.decode) intake) intakeSpec+          unknownHeader =+            mapIntake+              (\intake -> intakeWithBinds (updateFirst (bindRowWithSource (SrcHeader "x-custom")) intake.binds) intake)+              intakeSpec+          retryOnAppended =+            modifyProcess+              "HospitalSurge"+              ( \process ->+                  processWithHandle+                    ( handleWithDispatch+                        ( updateFirst+                            (\d -> dispatchNodeWithDisposition (dispatchDispositionWithOnAppended DRetry d.disposition) d)+                            (legacyProcessHandle process).dispatch+                        )+                        (legacyProcessHandle process)+                    )+                    process+              )+              processSpec+          firedNotMine =+            modifyProcess+              "HospitalSurge"+              ( \process ->+                  let timer = legacyProcessTimer process+                      fire = timer.fire+                   in processWithTimer+                        ( timerWithFire+                            (fireNodeWithDisposition (fireDispositionWithNotMine OFired fire.disposition) fire)+                            timer+                        )+                        process+              )+              processSpec+          routerRetryOnAppended =+            mapRouter+              ( \router ->+                  routerWithDispatch+                    (routerDispatchWithDisposition (dispatchDispositionWithOnAppended DRetry router.dispatch.disposition) router.dispatch)+                    router+              )+              routerSpec+          cases =+            [ (lenientBody, DecodeBodyPostureUnsupported),+              (unknownHeader, IntakeBindHeaderUnknown),+              (retryOnAppended, DispatchOnAppendedUnsupported),+              (firedNotMine, TimerNotMineUnsupported),+              (routerRetryOnAppended, DispatchOnAppendedUnsupported)+            ]+      forM_ cases $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldNotContain` [expected]+        serviceWarningCodes 3 candidate `shouldContain` [expected]+        serviceErrorCodes 4 candidate `shouldContain` [expected]++      -- The unmutated fixtures spell every one of these the way the runtime+      -- behaves, so language 4 has nothing to say about them.+      let closedCodes =+            [ DecodeBodyPostureUnsupported,+              IntakeBindHeaderUnknown,+              DispatchOnAppendedUnsupported,+              TimerNotMineUnsupported+            ]+      forM_ [intakeSpec, processSpec, routerSpec] $ \accepted -> do+        serviceErrorCodes 4 accepted `shouldNotContain` closedCodes+        serviceWarningCodes 4 accepted `shouldNotContain` closedCodes++    -- ExecPlan 197 parked these three as "explicitly descriptive-only"; ExecPlan+    -- 199 re-adjudicated each against the path it purports to describe and found+    -- a checkable referent in every one.+    it "checks the references the formerly descriptive-only surfaces name" $ do+      processSpec <- specOf "test/fixtures/hospital-surge.keiro"+      dispatchSpec <- specOf "test/fixtures/reservation-work.keiro"+      let unknownStatus =+            modifyProcess+              "HospitalSurge"+              (\process -> processWithTimer (timerWithDecodeUnknown "Abandoned" (legacyProcessTimer process)) process)+              processSpec+          blankDeadLetter =+            modifyProcess+              "HospitalSurge"+              (\process -> processWithTimer (timerWithDeadLetter "   " (legacyProcessTimer process)) process)+              processSpec+          phantomDedupeKey =+            mapPgmqDispatch (pgmqDispatchWithDedupKey "ghostKey") dispatchSpec+          uppercaseFanout =+            mapPgmqDispatch (pgmqDispatchWithFanoutBody "ResolveTransferCandidates") dispatchSpec+          cases =+            [ (unknownStatus, TimerDecodeStatusUnknown),+              (blankDeadLetter, TimerDeadLetterTextInvalid),+              (phantomDedupeKey, DispatchReadModelFieldUnknown),+              (uppercaseFanout, PgmqFanoutFunctionInvalid)+            ]+      forM_ cases $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldNotContain` [expected]+        serviceWarningCodes 3 candidate `shouldContain` [expected]+        serviceErrorCodes 4 candidate `shouldContain` [expected]++      -- Every timer status the runtime actually stores is accepted.+      forM_ ["Scheduled", "Firing", "Fired", "Cancelled", "Dead"] $ \status ->+        serviceErrorCodes+          4+          (modifyProcess "HospitalSurge" (\p -> processWithTimer (timerWithDecodeUnknown status (legacyProcessTimer p)) p) processSpec)+          `shouldNotContain` [TimerDecodeStatusUnknown]++      serviceErrorCodes 4 processSpec `shouldNotContain` [TimerDecodeStatusUnknown, TimerDeadLetterTextInvalid]+      serviceErrorCodes 4 dispatchSpec `shouldNotContain` [PgmqFanoutFunctionInvalid]++    it "holds a process dispatch-id line to the same strictness as a router's" $ do+      -- Both lines document a derivation the spec cannot change, but the two+      -- runtimes key on different tuples: Keiro.ProcessManager on+      -- (name, correlationId, sourceEventId, emitIndex) and Keiro.Router on+      -- (name, key, sourceEventId, targetStreamName, occurrence). Before+      -- ExecPlan 199 the process line accepted any strategy and any tuple.+      processSource <- readTestText "test/fixtures/hospital-surge.keiro"+      let processLine = "dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)"+          rejected =+            [ "dispatch-id strategy=md5 from=(name, correlationId, sourceEventId, emitIndex)",+              "dispatch-id strategy=uuidv5 from=(banana)",+              "dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId)",+              -- The router's tuple is not the process's tuple.+              "dispatch-id strategy=uuidv5 from=(name, key, sourceEventId, targetStreamName, occurrence)"+            ]+      processSource `shouldSatisfy` T.isInfixOf processLine+      parseSpec "accepted" processSource `shouldSatisfy` isRight+      forM_ rejected $ \badLine ->+        parseSpec "mutated" (T.replace processLine badLine processSource)+          `shouldSatisfy` isLeft++    it "gates the remaining locally resolvable identity and field surfaces on language 4" $ do+      reservation <- specOf "test/fixtures/reservation.keiro"+      emitSpec <- specOf "test/fixtures/emit.keiro"+      processSpec <- specOf "test/fixtures/hospital-surge.keiro"+      dispatchSpec <- specOf "test/fixtures/reservation-work.keiro"+      readModelSpec <- specOf "test/fixtures/readmodel.keiro"+      let projectionKey = modifyAggregate "Reservation" (\aggregate -> aggregateWithProjection (fmap (projectionSpecWithKey "ghost") aggregate.projection) aggregate) reservation+          outboxField = mapPublisher (publisherWithOutboxField "ghost") emitSpec+          timerIds =+            modifyProcess+              "HospitalSurge"+              ( \process ->+                  let timer = legacyProcessTimer process+                      fire = timer.fire+                   in processWithTimer+                        ( timerWithIdAndFire+                            (idExprWithField "ghostTimerKey" timer.id)+                            (fireNodeWithFiredEventId (idExprWithField "ghostEventKey" fire.firedEventId) fire)+                            timer+                        )+                        process+              )+              processSpec+          sourceKey = mapDispatch (pgmqDispatchWithSourceKey "ghost") dispatchSpec+          subscriptionIdentity = modifyReadModel "transfer_decisions" (\readModel -> readModelWithSupply (setLegacySubscription (Just "bad subscription") readModel.supply) readModel) readModelSpec+          scopeIdentity = modifyReadModel "transfer_decisions" (\readModel -> readModelWithSupply (setLegacyScope (Just (RmCategory "bad-category")) readModel.supply) readModel) readModelSpec+          cases =+            [ (projectionKey, AggProjectionKeyUnresolved),+              (outboxField, PublisherOutboxFieldUnresolved),+              (timerIds, TimerIdFieldNotCorrelation),+              (sourceKey, DispatchReadModelFieldUnknown),+              (subscriptionIdentity, RuntimeIdentityInvalid),+              (scopeIdentity, RuntimeIdentityInvalid)+            ]+      forM_ cases $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldBe` []+        serviceErrorCodes 4 candidate `shouldContain` [expected]+      length (filter (== TimerIdFieldNotCorrelation) (serviceErrorCodes 4 timerIds)) `shouldBe` 2+      parseStableRenderedSpec "<timer-id-fields>" timerIds `shouldBe` Right timerIds+    it "uses a router-specific code for a confirmed duplicate inversion" $ do+      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      let changed =+            modifyRouter+              "PagingRouter"+              ( \router ->+                  let dispatch = router.dispatch+                      disposition = dispatch.disposition+                   in routerWithDispatch+                        (routerDispatchWithDisposition (dispatchDispositionWithOnDuplicate DAckOk disposition) dispatch)+                        router+              )+              spec+          warningCodes = [(.code) diagnostic | diagnostic <- validateSpec changed, (.severity) diagnostic == Warning]+      warningCodes `shouldContain` [RouterBenignInversion]+      warningCodes `shouldNotContain` [ProcessBenignInversion]+    it "pins every emitted legacy single-spec diagnostic that lacked a direct negative test" $ do+      reservation <- specOf "test/fixtures/reservation.keiro"+      intakeSpec <- specOf "test/fixtures/intake.keiro"+      emitSpec <- specOf "test/fixtures/emit.keiro"+      processSpec <- specOf "test/fixtures/surge-service.keiro"+      queueSpec <- specOf "test/fixtures/reservation-work.keiro"+      workflowSpec <- specOf "test/fixtures/workflow.keiro"+      let updateFirstTransition update aggregate = aggregateWithTransitions (updateFirst update aggregate.transitions) aggregate+          undeclaredEvent = modifyAggregate "Reservation" (updateFirstTransition (transitionWithEmits ["GhostEvent"])) reservation+          undeclaredState = modifyAggregate "Reservation" (updateFirstTransition (transitionWithGoto "GhostState")) reservation+          terminalOutgoing = modifyAggregate "Reservation" (updateFirstTransition (transitionWithSource "Expired")) reservation+          deprecatedEmitted = modifyAggregate "Reservation" (\aggregate -> aggregateWithEvents (updateFirst (eventWithDeprecated True) aggregate.events) aggregate) reservation+          wireVersionMismatch = modifyAggregate "Reservation" (\aggregate -> aggregateWithWire (fmap (wireSpecWithSchemaVersion 2) aggregate.wire) aggregate) reservation+          decodeRetry =+            mapIntake+              ( \intake ->+                  intakeWithDisposition+                    [ if row.outcome == "decodeFailed" then dispositionRowWithAction (IRetry "5s") row else row+                    | row <- intake.disposition+                    ]+                    intake+              )+              intakeSpec+          unresolvedPublisher = mapPublisher (publisherWithEmit "ghost") emitSpec+          unresolvedIntake = mapIntake (intakeWithContract "ghost") intakeSpec+          unboundedQueue = mapWorkqueue (workqueueWithMaxRetries 0) queueSpec+          unresolvedEnqueue = mapDispatch (pgmqDispatchWithEnqueueTo "ghost") queueSpec+          unresolvedWorkflow =+            mapOperation+              ( \operation -> case (.shape) operation of+                  RunOp _ input outcome -> operationWithShape (RunOp "GhostWorkflow" input outcome) operation+                  _ -> operation+              )+              workflowSpec+          cases =+            [ (undeclaredEvent, UndeclaredEvent),+              (undeclaredState, UndeclaredState),+              (terminalOutgoing, TerminalHasOutgoing),+              (deprecatedEmitted, DeprecatedEventStillEmitted),+              (wireVersionMismatch, WireSchemaVersionMismatch),+              (processSpec, ProcessBenignInversion),+              (decodeRetry, DispositionDecodeUnboundedRetry),+              (unresolvedPublisher, PublisherUnresolvedEmit),+              (unresolvedIntake, IntakeUnresolvedContract),+              (unboundedQueue, WqDlqWithoutCeiling),+              (unresolvedEnqueue, DispatchEnqueueUnresolved),+              (unresolvedWorkflow, RunWorkflowUnresolved)+            ]+      forM_ cases $ \(candidate, expected) -> diagnosticCodes candidate `shouldContain` [expected]+    it "rejects a missing status-map as StatusMapNotTotal" $ do+      codes <- diagnosticCodesOf "test/fixtures/reservation-no-statusmap.keiro"+      codes `shouldContain` [StatusMapNotTotal]+    it "rejects an undeclared command as UndeclaredCommand" $ do+      codes <- diagnosticCodesOf "test/fixtures/reservation-bad-command.keiro"+      codes `shouldContain` [UndeclaredCommand]+    it "rejects a wall-clock guard atom as ClockSampled" $ do+      codes <- diagnosticCodesOf "test/fixtures/reservation-clock.keiro"+      codes `shouldContain` [ClockSampled]+    it "accepts a v2 event with a contiguous upcaster hole" $ do+      codes <- errorCodesOf "test/fixtures/reservation-v2.keiro"+      codes `shouldBe` []+    it "rejects a v2 event with no upcaster as EvtVersionMissingUpcaster" $ do+      codes <- diagnosticCodesOf "test/fixtures/reservation-v2-noupcast.keiro"+      codes `shouldContain` [EvtVersionMissingUpcaster]+    it "accepts shared upcaster sources for different event kinds" $ do+      codes <- errorCodesOf "test/fixtures/reservation-dup-upcast-source.keiro"+      codes `shouldBe` []+    it "rejects a gap in the aggregate-global upcaster chain" $ do+      codes <- errorCodesOf "test/fixtures/reservation-chain-gap.keiro"+      codes `shouldContain` [UpcasterChainGap]+    it "warns while a retiring event keeps its live emitting transition" $ do+      diagnostics <- diagnosticsOf "test/fixtures/reservation-retiring.keiro"+      [(.code) d | d <- diagnostics, (.severity) d == Error] `shouldBe` []+      [(.code) d | d <- diagnostics, (.severity) d == Warning]+        `shouldContain` [EventRetirementInProgress]+    it "rejects a retiring event after its live emitting transition disappears" $ do+      source <- readTestText "test/fixtures/reservation-retiring.keiro"+      spec <- parseInlineSpec "<retiring-without-emitter>" (T.replace "emit TransferReservationConfirmed ; " "" source)+      [(.code) d | d <- validateSpec spec, (.severity) d == Error]+        `shouldContain` [EventRetirementInProgress]+    it "warns when a deprecated event has no replay-only emitting transition" $ do+      diagnostics <- diagnosticsOf "test/fixtures/reservation-deprecated.keiro"+      [(.code) d | d <- diagnostics, (.severity) d == Error] `shouldBe` []+      [(.code) d | d <- diagnostics, (.severity) d == Warning]+        `shouldContain` [DeprecatedEventReplayHazard]+    it "recognises deprecated plus replay-only as the replay-safe cutover" $ do+      diagnostics <- diagnosticsOf "test/fixtures/reservation-deprecated-replay-only.keiro"+      [(.code) d | d <- diagnostics, (.severity) d == Error] `shouldBe` []+      [(.code) d | d <- diagnostics, (.severity) d == Warning]+        `shouldContain` [EventRetirementInProgress]+      [(.code) d | d <- diagnostics] `shouldNotContain` [DeprecatedEventReplayHazard]+    it "requires exact, unique status-map event keys" $ do+      dangling <- errorCodesOf "test/fixtures/statusmap-dangling.keiro"+      mapM_ (\expected -> dangling `shouldContain` [expected]) [StatusMapDanglingKey, StatusMapNotTotal]+      duplicate <- errorCodesOf "test/fixtures/statusmap-dup-key.keiro"+      duplicate `shouldContain` [StatusMapDuplicateKey]+    it "rejects duplicate aggregate source subjects before semantic duplicate-name validation" $ do+      source <- readTestText "test/fixtures/duplicate-names.keiro"+      surface <- case parseSurfaceSource "test/fixtures/duplicate-names.keiro" source of+        Left frontendFailure -> expectationFailure (show frontendFailure) >> fail "unreachable"+        Right value -> pure value+      case lowerSurfaceDocument surface of+        Left LoweringFailure {code = SemanticSourceIndexInvalid DuplicateSourceSubject} -> pure ()+        other -> expectationFailure ("expected duplicate source-subject lowering refusal, got " <> show other)++      let withoutDuplicateAggregate = T.unlines (reverse (drop 3 (reverse (T.lines source))))+      parsed <- case parseSource "test/fixtures/duplicate-names.keiro" withoutDuplicateAggregate of+        Left parseFailure -> expectationFailure (show parseFailure) >> fail "unreachable"+        Right value -> pure value+      let spec = parsed.spec+          codes = [(.code) diagnostic | diagnostic <- validateSpec spec, (.severity) diagnostic == Error]+      mapM_+        (\expected -> codes `shouldContain` [expected])+        [ DuplicateEnumCtor,+          DuplicateEnumWire,+          DuplicateIdPrefix,+          DuplicateCommandName,+          DuplicateEventName+        ]+      case [node | node@NAggregate {} <- (.nodes) spec] of+        aggregateNode : _ ->+          [(.code) diagnostic | diagnostic <- validateSpec (specWithNodes (spec.nodes <> [aggregateNode]) spec), (.severity) diagnostic == Error]+            `shouldContain` [DuplicateNodeName]+        [] -> expectationFailure "duplicate-name fixture lost its aggregate"+    it "rejects aggregate-local references that do not resolve" $ do+      codes <- errorCodesOf "test/fixtures/aggregate-bad-refs.keiro"+      mapM_ (\expected -> codes `shouldContain` [expected]) [RegisterInitialOutOfScope, UndeclaredCommand, WriteTargetNotRegister]+    it "anchors UnreachableState on the state row" $ do+      let src =+            T.unlines+              [ "context repro",+                "",+                "aggregate Thing",+                "  regs",+                "  states",+                "    Initial",+                "    Unreachable"+              ]+      case parseSpec "<unreachable-row>" src of+        Left err -> expectationFailure (T.unpack err)+        Right spec ->+          [(.line) d | d <- validateSpec spec, (.code) d == UnreachableState]+            `shouldBe` [7]+    it "accepts a replay-only twin with a live sibling (plan 143)" $ do+      codes <- errorCodesOf "test/fixtures/reservation-guard-tightened-twin.keiro"+      codes `shouldBe` []+    it "rejects a replay-only transition that emits nothing" $ do+      case parseSpec "<replay-only-no-emit>" (replayOnlySpecWith ["    write reservationState := Held", "    goto  Held"]) of+        Left err -> expectationFailure (T.unpack err)+        Right spec ->+          [(.code) d | d <- validateSpec spec, (.severity) d == Error]+            `shouldContain` [ReplayOnlyEmitsNothing]+    it "warns when a replay-only transition has no live sibling" $ do+      case parseSpec "<replay-only-orphan>" (replayOnlySpecWith ["    emit  TransferReservationCreated", "    goto  Held"]) of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> do+          [(.code) d | d <- validateSpec spec, (.severity) d == Warning]+            `shouldContain` [ReplayOnlyCommandStillLive]+          [(.code) d | d <- validateSpec spec, (.severity) d == Error]+            `shouldNotContain` [ReplayOnlyCommandStillLive]++  describe "complementExpr (plan 143)" $ do+    it "applies De Morgan over and/or and flips comparison operators" $ do+      let a = EAtom (AName "a")+          b = EAtom (AName "b")+      complementExpr (EAnd a b)+        `shouldBe` EOr (ECmp OpEq a (EAtom (ABool False))) (ECmp OpEq b (EAtom (ABool False)))+      complementExpr (ECmp OpLt a b) `shouldBe` ECmp OpGe a b+      complementExpr (ECmp OpEq a b) `shouldBe` ECmp OpNeq a b+      complementExpr (ECmp OpLe a b) `shouldBe` ECmp OpGt a b+      complementExpr (ECmp OpGt a b) `shouldBe` ECmp OpLe a b+      complementExpr (ECmp OpGe a b) `shouldBe` ECmp OpLt a b+      complementExpr (ECmp OpNeq a b) `shouldBe` ECmp OpEq a b+    it "flips boolean literals and grounds bare names as == false" $ do+      complementExpr (EAtom (ABool True)) `shouldBe` EAtom (ABool False)+      complementExpr (EAtom (AName "open"))+        `shouldBe` ECmp OpEq (EAtom (AName "open")) (EAtom (ABool False))+    it "stays inside the grammar: the complement of any guard re-parses" $+      property $+        forAll genExpr $ \e ->+          let twin =+                replayOnlySpecWith+                  [ "    guard " <> renderExprText (complementExpr e),+                    "    emit  TransferReservationCreated",+                    "    goto  Held"+                  ]+           in case parseSpec "<complement>" twin of+                Left err -> counterexample (T.unpack err) False+                Right spec ->+                  [(.guard) t | NAggregate a <- (.nodes) spec, t <- (.transitions) a]+                    === [Just (complementExpr e)]++  describe "evolution parsing" $ do+    it "parses event version and upcaster from reservation-v2.keiro" $ do+      input <- readTestText "test/fixtures/reservation-v2.keiro"+      case parseSpec "test/fixtures/reservation-v2.keiro" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> case [e | NAggregate a <- (.nodes) spec, e <- (.events) a, (.name) e == "TransferReservationCreated"] of+          (e : _) -> do+            (.version) e `shouldBe` 2+            (.upcastFrom) e `shouldBe` Just (1, Hole)+          [] -> expectationFailure "TransferReservationCreated not found"+    it "round-trips the retiring marker" $ do+      spec <- specOf "test/fixtures/reservation-retiring.keiro"+      parseStableRenderedSpec "<retiring-round-trip>" spec `shouldBe` Right spec+      [(.retiring) event | NAggregate aggregate <- (.nodes) spec, event <- (.events) aggregate, (.name) event == "TransferReservationConfirmed"]+        `shouldBe` [True]+    it "rejects an event marked both retiring and deprecated" $ do+      source <- readTestText "test/fixtures/reservation-retiring.keiro"+      let conflicting = T.replace "retiring event TransferReservationConfirmed" "retiring deprecated event TransferReservationConfirmed" source+      parseSpec "<conflicting-retirement-markers>" conflicting `shouldSatisfy` isLeft++  describe "aggregate snapshots (EP-109)" $ do+    it "parses, validates, and round-trips a snapshot policy with codec fixture" $ do+      spec <- specOf "test/fixtures/reservation-snapshot.keiro"+      errorCodesOf "test/fixtures/reservation-snapshot.keiro" `shouldReturn` []+      parseStableRenderedSpec "<snapshot-round-trip>" spec `shouldBe` Right spec+      case [aggregate | NAggregate aggregate <- (.nodes) spec] of+        [aggregate] -> (.snapshot) aggregate `shouldBe` Just (SnapshotSpec (SnapEvery 100) 1 "7a181ceb7d798d883d28c85201c5c1692bd314a7b489da9128bff91e0f38cd28" noLoc)+        aggregates -> expectationFailure ("expected one snapshot aggregate, got " <> show (length aggregates))+    it "rejects disabled intervals and invalid codec fixtures" $ do+      source <- readTestText "test/fixtures/reservation-snapshot.keiro"+      interval <- parseInlineSpec "<snapshot-zero>" (T.replace "snapshot every 100" "snapshot every 0" source)+      map (.code) (validateSpec interval) `shouldContain` [SnapshotIntervalInvalid]+      version <- parseInlineSpec "<snapshot-version-zero>" (T.replace "state-codec version=1" "state-codec version=0" source)+      map (.code) (validateSpec version) `shouldContain` [SnapshotCodecFixtureInvalid]+      emptyHash <- parseInlineSpec "<snapshot-empty-hash>" (T.replace "shape-hash=\"7a181ceb7d798d883d28c85201c5c1692bd314a7b489da9128bff91e0f38cd28\"" "shape-hash=\"\"" source)+      map (.code) (validateSpec emptyHash) `shouldContain` [SnapshotCodecFixtureInvalid]+    it "conditionally lowers JSON instances and the live defaultStateCodec" $ do+      snapshotService <- checkedServiceOf "test/fixtures/reservation-snapshot.keiro"+      ordinaryService <- checkedServiceOf "test/fixtures/reservation.keiro"+      let snapshot = checkedSpec snapshotService+          ordinary = checkedSpec ordinaryService+      case ([aggregate | NAggregate aggregate <- (.nodes) snapshot], [aggregate | NAggregate aggregate <- (.nodes) ordinary]) of+        ([_], [_]) -> do+          let snapshotModules = scaffoldServiceModules (defaultContext (snapshot.context)) snapshotService+              ordinaryModules = scaffoldServiceModules (defaultContext (ordinary.context)) ordinaryService+              snapshotDomain = generatedTextEndingIn "Domain.hs" snapshotModules+              snapshotStream = generatedTextEndingIn "EventStream.hs" snapshotModules+              ordinaryDomain = generatedTextEndingIn "Domain.hs" ordinaryModules+              ordinaryStream = generatedTextEndingIn "EventStream.hs" ordinaryModules+          snapshotDomain `shouldSatisfy` T.isInfixOf "deriving anyclass (ToJSON, FromJSON)"+          snapshotStream `shouldSatisfy` T.isInfixOf "snapshotPolicy = Every 100"+          snapshotStream `shouldSatisfy` T.isInfixOf "stateCodec = Just (withFoldFingerprint"+          snapshotStream `shouldSatisfy` T.isInfixOf "Spec-visible fold changes invalidate old"+          snapshotStream `shouldSatisfy` T.isInfixOf "reservationSnapshotFixture = (1, \"7a181ceb7d798d883d28c85201c5c1692bd314a7b489da9128bff91e0f38cd28\")"+          ordinaryDomain `shouldNotSatisfy` T.isInfixOf "DeriveAnyClass"+          ordinaryStream `shouldSatisfy` T.isInfixOf "snapshotPolicy = Never"+          ordinaryStream `shouldSatisfy` T.isInfixOf "stateCodec = Nothing"+          ordinaryStream `shouldSatisfy` T.isInfixOf "reservationCategory = Stream.categoryUnsafe \"reservation\""+          firewallBreaches snapshotModules `shouldBe` []+        _ -> expectationFailure "expected one aggregate in each snapshot test spec"++  describe "aggregate fold fingerprints (plan 138)" $ do+    it "is deterministic across repeated parses and formatting-only changes" $ do+      source <- readTestText "test/fixtures/reservation.keiro"+      first <- parseInlineSpec "<first>" source+      second <- shouldParseStableRenderedSpec "<second>" first+      aggregateFoldFingerprint first (onlyAggregate first)+        `shouldBe` aggregateFoldFingerprint second (onlyAggregate second)+    it "changes for transition writes, guards, and referenced rule bodies" $ do+      base <- specOf "test/fixtures/reservation.keiro"+      writeChanged <- specOf "test/fixtures/reservation-foldchange.keiro"+      guardChanged <- specOf "test/fixtures/reservation-guard-tightened.keiro"+      source <- readTestText "test/fixtures/reservation.keiro"+      ruleChanged <- parseInlineSpec "<rule-change>" (T.replace "RedTag => true" "RedTag => false" source)+      let baseFingerprint = aggregateFoldFingerprint base (onlyAggregate base)+      aggregateFoldFingerprint writeChanged (onlyAggregate writeChanged) `shouldNotBe` baseFingerprint+      aggregateFoldFingerprint guardChanged (onlyAggregate guardChanged) `shouldNotBe` baseFingerprint+      aggregateFoldFingerprint ruleChanged (onlyAggregate ruleChanged) `shouldNotBe` baseFingerprint+    it "ignores wire and projection changes" $ do+      base <- specOf "test/fixtures/reservation.keiro"+      wireChanged <- specOf "test/fixtures/reservation-wire.keiro"+      source <- readTestText "test/fixtures/reservation.keiro"+      projectionChanged <- parseInlineSpec "<projection-change>" (T.replace "projection transfer_decisions" "projection renamed_projection" source)+      let surface = aggregateFoldSurface base (onlyAggregate base)+      aggregateFoldSurface wireChanged (onlyAggregate wireChanged) `shouldBe` surface+      aggregateFoldSurface projectionChanged (onlyAggregate projectionChanged) `shouldBe` surface+    it "invalidates mapped-register snapshots when binding or wire identity changes" $ do+      base <- specOf "test/fixtures/consumer-types.keiro"+      bindingChanged <- specOf "test/fixtures/consumer-types-binding-change.keiro"+      wireChanged <- specOf "test/fixtures/consumer-types-wirekey.keiro"+      let baseFingerprint = aggregateFoldFingerprint base (onlyAggregate base)+      aggregateFoldFingerprint bindingChanged (onlyAggregate bindingChanged) `shouldNotBe` baseFingerprint+      aggregateFoldFingerprint wireChanged (onlyAggregate wireChanged) `shouldNotBe` baseFingerprint+    it "invalidates nested nominal folds for representation, binding, and canonical changes only" $ do+      baseSource <- readTestText "test/fixtures/structural-nominal-leaves.keiro"+      base <- checkedServiceFromText "structural-nominal-leaves.keiro" baseSource+      prefixChanged <- checkedServiceOf "test/fixtures/structural-nominal-leaves-prefix-change.keiro"+      bindingChanged <- checkedServiceOf "test/fixtures/structural-nominal-leaves-binding-change.keiro"+      enumSpellingChanged <- checkedServiceOf "test/fixtures/structural-nominal-leaves-enum-spelling.keiro"+      canonicalChanged <-+        checkedServiceFromText+          "structural-nominal-leaves-canonical-change.keiro"+          (T.replace "conformance.structural-nominals.ClaimId.v1" "conformance.structural-nominals.ClaimId.v2" baseSource)+      fixturesChanged <-+        checkedServiceFromText+          "structural-nominal-leaves-fixtures-change.keiro"+          (T.replace "Bindings.claimIdFixtures" "Bindings.claimIdFixturesV2" baseSource)+      unrelated <-+        checkedServiceFromText+          "structural-nominal-leaves-unrelated.keiro"+          (T.replace "id TemplateId prefix=template" "id UnusedId prefix=unused\nid TemplateId prefix=template" baseSource)+      let fingerprint service = aggregateFoldFingerprintForService service (onlyAggregate (checkedSpec service))+          surface = aggregateFoldSurfaceForService base (onlyAggregate (checkedSpec base))+          generatedTransducer =+            generatedTextEndingIn+              "TemplateCatalog/Transducer.hs"+              (scaffoldServiceModules (defaultContext ((checkedSpec base).context)) base)+      surface `shouldSatisfy` T.isInfixOf "nested-nominal-use:TemplateCatalog event TemplateRecorded .state : TemplateState .templateId : TemplateId"+      surface `shouldSatisfy` T.isInfixOf "nested-nominal-use:TemplateCatalog register book : TemplateBook .holders [] optional : ClaimId"+      surface `shouldSatisfy` T.isInfixOf "nested-nominal-use:TemplateCatalog register book : TemplateBook .claims {key} : ClaimId"+      generatedTransducer `shouldSatisfy` T.isInfixOf (fingerprint base)+      map fingerprint [prefixChanged, bindingChanged, canonicalChanged, enumSpellingChanged]+        `shouldSatisfy` all (/= fingerprint base)+      map fingerprint [fixturesChanged, unrelated]+        `shouldSatisfy` all (== fingerprint base)++  describe "process/timer (EP-3)" $ do+    it "parses the hospital-surge process + nested timer" $ do+      input <- readTestText "test/fixtures/hospital-surge.keiro"+      case parseSpec "test/fixtures/hospital-surge.keiro" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> case [p | NProcess p <- (.nodes) spec] of+          (p : _) -> do+            p.id `shouldBe` "HospitalSurge"+            (.name) p `shouldBe` "hospital-surge"+            (.rejected) p `shouldBe` PolHalt+            (.poison) p `shouldBe` PolHalt+            (.category) ((.saga) p) `shouldBe` "hospitalSurge"+            (.name) (legacyProcessTimer p) `shouldBe` "surgeFollowUp"+            (.onReject) ((.disposition) ((.fire) (legacyProcessTimer p))) `shouldBe` OFired+            (.onAmbiguous) ((.disposition) ((.fire) (legacyProcessTimer p))) `shouldBe` ORetry+            (.maxAttempts) (legacyProcessTimer p) `shouldBe` 5+          [] -> expectationFailure "no process node parsed"+    it "round-trips the hospital-surge spec through parse . pretty" $ do+      input <- readTestText "test/fixtures/hospital-surge.keiro"+      case parseSpec "in" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> parseLanguage4RenderedSpec "in" spec `shouldBe` Right spec+    it "parses and round-trips Language 6 reaction processes" $ do+      forM_+        [ "test/fixtures/process-reactions.keiro",+          "test/fixtures/process-timers.keiro",+          "test/fixtures/process-state-authority.keiro"+        ]+        $ \path -> do+          source <- readTestText path+          parsed <- case parseSource path source of+            Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+            Right value -> pure value+          parseSource (path <> ".roundtrip") (renderSource parsed) `shouldBe` Right parsed+      stateAuthority <- specOf "test/fixtures/process-state-authority.keiro"+      case [process | NProcess process <- (.nodes) stateAuthority] of+        [process] -> case (.body) process of+          ReactionProcessBody reaction -> do+            (.version) reaction `shouldBe` 1+            length (NE.toList ((.inputs) reaction)) `shouldBe` 4+            length (NE.toList ((.reactions) reaction)) `shouldBe` 4+            length ((.timers) reaction) `shouldBe` 1+          LegacyProcessBody {} -> expectationFailure "Language 6 reaction parsed as legacy process"+        processes -> expectationFailure ("expected one reaction process, got " <> show (length processes))+    it "gates reaction syntax at the reactions marker before Language 6" $ do+      source <- readTestText "test/fixtures/process-reactions-language5.keiro"+      case parseSurfaceSource "process-reactions-language5.keiro" source of+        Left FrontendFailure {code = SourceLanguageError LanguageFeatureRequiresVersion, span = SourceSpan {start = SourcePoint {offset = startOffset}, end = SourcePoint {offset = endOffset}}} ->+          T.take (endOffset - startOffset) (T.drop startOffset source) `shouldBe` "reactions"+        Left failure -> expectationFailure (show failure)+        Right _ -> expectationFailure "Language 5 unexpectedly accepted process reactions"+    it "rejects every process-reaction validation fixture with its stable diagnostic code" $ do+      let cases =+            [ ("unknown-input", ProcessReactionUnknownInput),+              ("duplicate-input-declaration", ProcessInputDuplicateDeclaration),+              ("duplicate-timer", ProcessTimerDuplicateName),+              ("guard-not-boolean", ProcessReactionGuardNotBoolean),+              ("state-access", ProcessStateAccessUnsupported),+              ("input-unhandled", ProcessReactionInputUnhandled),+              ("duplicate-on", ProcessReactionDuplicateInput),+              ("otherwise-missing", ProcessReactionOtherwiseMissing),+              ("otherwise-unreachable", ProcessReactionOtherwiseUnreachable),+              ("timer-prefix-collision", ProcessTimerPrefixCollision),+              ("schedule-unknown", ProcessScheduleUnknownTimer),+              ("cancel-unknown", ProcessCancelUnknownTimer),+              ("payload-incomplete", ProcessSchedulePayloadIncomplete),+              ("timer-policy-missing", ProcessTimerPolicyMissing),+              ("timer-policy-unused", ProcessTimerPolicyUnused),+              ("accepted-requires-event", ProcessAcceptedArmRequiresEvent),+              ("silent-missing", ProcessSilentArmMissing),+              ("accepted-unverified", ProcessAcceptedArmUnverified),+              ("badmapping", ProcessBindingTypeMismatch)+            ]+      forM_ cases $ \(suffix, expected) ->+        errorCodesOf ("test/fixtures/process-reactions-" <> suffix <> ".keiro") `shouldReturn` [expected]+    it "accepts the hospital-surge spec (no errors; benign-inversion warnings only)" $ do+      codes <- errorCodesOf "test/fixtures/hospital-surge.keiro"+      codes `shouldBe` []+    it "rejects illegal saga categories and no longer parses the raw stream-prefix clause" $ do+      spec <- specOf "test/fixtures/hospital-surge.keiro"+      mapM_+        (\categoryName -> processErrorCodes (\process -> processWithSaga (sagaRefWithCategory categoryName process.saga) process) spec `shouldContain` [SagaCategoryIllegal])+        ["", "$all", "hospital-surge", "hospital surge", "wf:surge"]+      source <- readTestText "test/fixtures/hospital-surge.keiro"+      parseSpec "<legacy-saga>" (T.replace "saga Surge category \"hospitalSurge\"" "saga Surge stream=\"hospital-surge-\" <> correlationId" source)+        `shouldSatisfy` isLeft+    it "rejects a wall-clock fireAt as ProcessFireAtNotInjected" $ do+      codes <- errorCodesOf "test/fixtures/hospital-surge-clock.keiro"+      codes `shouldContain` [ProcessFireAtNotInjected]+    it "reports one ProcessFireAtNotInjected for a wholly unknown fireAt field" $ do+      codes <- errorCodesOf "test/fixtures/hospital-surge-clock.keiro"+      length (filter (== ProcessFireAtNotInjected) codes) `shouldBe` 1+    it "rejects a user-supplied dispatch id as ProcessDispatchIdSupplied" $ do+      codes <- errorCodesOf "test/fixtures/hospital-surge-dispatchid.keiro"+      codes `shouldContain` [ProcessDispatchIdSupplied]+    it "rejects an unresolved saga reference as ProcessUnresolvedRef" $ do+      codes <- errorCodesOf "test/fixtures/hospital-surge-badref.keiro"+      codes `shouldContain` [ProcessUnresolvedRef]+    it "rejects unresolved process commands, projections, schedules, and advance ids" $ do+      codes <- errorCodesOf "test/fixtures/process-ghost-refs.keiro"+      length (filter (== ProcessUnresolvedRef) codes) `shouldBe` 5+      codes `shouldContain` [ProcessDispatchIdSupplied]+    it "gates process correlate, dispatch-key, and binding scopes on language 4" $ do+      spec <- specOf "test/fixtures/hospital-surge.keiro"+      let badCorrelate =+            modifyProcess+              "HospitalSurge"+              (\process -> processWithCorrelate (correlateDeclWithField "ghost" process.correlate) process)+              spec+          badDispatchKey =+            modifyProcess+              "HospitalSurge"+              ( \process ->+                  let handle = legacyProcessHandle process+                   in processWithHandle (handleWithDispatch (updateFirst (dispatchNodeWithKey "input.ghost") handle.dispatch) handle) process+              )+              spec+          badBinding =+            modifyProcess+              "HospitalSurge"+              ( \process ->+                  let handle = legacyProcessHandle process+                      advance = handle.advance+                   in processWithHandle+                        (handleWithAdvance (advanceNodeWithFields (updateFirst (fieldBindingWithValue (Just "ghost.value")) advance.advFields) advance) handle)+                        process+              )+              spec+          cases =+            [ (badCorrelate, ProcessKeyFieldUnknown),+              (badDispatchKey, ProcessDispatchKeyUnresolved),+              (badBinding, ProcessBindingUnscoped)+            ]+      forM_ cases $ \(candidate, expected) -> do+        serviceErrorCodes 3 candidate `shouldNotContain` [expected]+        serviceErrorCodes 4 candidate `shouldContain` [expected]+      serviceErrorCodes 4 spec+        `shouldNotContain` [ProcessKeyFieldUnknown, ProcessDispatchKeyUnresolved, ProcessBindingUnscoped]++  describe "router (EP-108)" $ do+    it "checks nominal ID keys, recipients, comparisons, literals, and command mappings" $ do+      service <- checkedServiceOf "test/fixtures/structural-nominal-leaves.keiro"+      let spec = checkedSpec service+      graph <- shouldResolveTypeGraph spec+      case [router | NRouter router <- (.nodes) spec, (.id) router == "TemplateDeliveryRouter"] of+        [router] -> case RouterSelection.checkRouterSelection (checkedLanguageContract service) graph spec router of+          Left diagnostics -> expectationFailure (show diagnostics)+          Right selection -> do+            (.valueType) ((.key) selection) `shouldBe` RouterSelection.SelectionNominal "ClaimId"+            (.valueType) ((.recipient) selection) `shouldBe` RouterSelection.SelectionNominal "TemplateId"+            (.valueType) (fromMaybe (error "templateId command mapping missing") (Map.lookup "templateId" ((.commandFields) selection)))+              `shouldBe` RouterSelection.SelectionNominal "TemplateId"+            show ((.predicate) selection) `shouldContain` "CheckedIdLiteral \"TemplateId\""+            T.length ((.fingerprint) selection) `shouldBe` 64+        routers -> expectationFailure ("expected the nominal declarative router, got " <> show (length routers))+      let modules = scaffoldServiceModules (defaultContext (spec.context)) service+          routerModule = generatedTextEndingIn "TemplateDeliveryRouter/Router.hs" modules+      routerModule `shouldSatisfy` T.isInfixOf "fieldWitnessGet StructuralProjections.templateLookupRowTemplateIdWitness row"+      routerModule `shouldSatisfy` T.isInfixOf "StructuralProjections.templateLookupRowTemplateIdRawGet row"+      routerModule `shouldSatisfy` T.isInfixOf "template_01h455vb4pex5vsknk084sn02q"++    it "RouterSelection parses, checks, fingerprints, and round-trips bounded declarative selection" $ do+      source <- readTestText "test/fixtures/declarative-router/valid.keiro"+      parsed <- case parseSource "declarative-router.keiro" source of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let service = checkedSource parsed+          spec = checkedSpec service+      [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error] `shouldBe` []+      parseSource "declarative-router-roundtrip.keiro" (renderSource parsed) `shouldBe` Right parsed+      graph <- shouldResolveTypeGraph spec+      case [router | NRouter router <- (.nodes) spec] of+        [router] -> case RouterSelection.checkRouterSelection (checkedLanguageContract service) graph spec router of+          Left diagnostics -> expectationFailure (show diagnostics)+          Right selection -> do+            (.identity) selection `shouldBe` "hospital-transfer-selection"+            (.version) selection `shouldBe` 1+            (.limit) selection `shouldBe` 64+            (.useSites) selection `shouldSatisfy` (not . null)+            T.length ((.fingerprint) selection) `shouldBe` 64+            (.fingerprint) selection+              `shouldSatisfy` T.all (`elem` ("0123456789abcdef" :: String))+        routers -> expectationFailure ("expected one declarative router, got " <> show (length routers))++    it "generates the checked declarative selection without a selection-owned RouterHoles module" $ do+      service <- checkedServiceOf "test/fixtures/declarative-router/valid.keiro"+      let spec = checkedSpec service+          modules = scaffoldServiceModules (defaultContext (spec.context)) service+          routerModule = generatedTextEndingIn "HospitalTransferRouter/Router.hs" modules+          routerHarness = generatedTextEndingIn "HospitalTransferRouter/RouterHarness.hs" modules+      [(.path) generatedModule | generatedModule <- modules, "HospitalTransferRouter/Router.hs" `T.isSuffixOf` T.pack ((.path) generatedModule)]+        `shouldBe` ["Generated/TransferRouting/HospitalTransferRouter/Router.hs"]+      [(.path) hole | hole <- modules, "HospitalTransferRouter/RouterHoles.hs" `T.isSuffixOf` T.pack ((.path) hole)]+        `shouldBe` []+      routerModule `shouldSatisfy` T.isInfixOf "DeclarativeRouter"+      routerModule `shouldSatisfy` T.isInfixOf "runQuery Nothing SelectionQuery.hospitalLoadReadModel input"+      routerModule `shouldSatisfy` T.isInfixOf "fieldWitnessGet StructuralProjections.hospitalLoadRowHospitalIdWitness row"+      routerModule `shouldSatisfy` T.isInfixOf "hospitalTransferRouterSelectionContract"+      routerModule `shouldSatisfy` T.isInfixOf "hospitalTransferRouterSelectionFingerprint"+      routerHarness `shouldSatisfy` T.isInfixOf "(\"resolverOwnership\", \"generated-declarative\")"+      routerHarness `shouldSatisfy` T.isInfixOf "(\"maxRecipients\", \"64\")"+      firewallBreaches modules `shouldBe` []++    it "classifies every declarative selection coordination transition" $ do+      source <- readTestText "test/fixtures/declarative-router/valid.keiro"+      baseline <- checkedServiceFromText "selection-baseline.keiro" source+      identityChanged <- checkedServiceFromText "selection-identity.keiro" (T.replace "identity = \"hospital-transfer-selection\"" "identity = \"hospital-transfer-selection-v2\"" source)+      versionTwo <- checkedServiceFromText "selection-version-two.keiro" (T.replace "version = 1" "version = 2" source)+      fingerprintChanged <- checkedServiceFromText "selection-fingerprint.keiro" (T.replace "max-recipients = 64" "max-recipients = 32" source)+      versionedFingerprintChanged <- checkedServiceFromText "selection-versioned-fingerprint.keiro" (T.replace "version = 1" "version = 2" (T.replace "max-recipients = 64" "max-recipients = 32" source))+      let custom =+            checkedServiceWithSpec+              ( modifyRouter+                  "HospitalTransferRouter"+                  ( \router ->+                      router+                        { input = ((.input) router) {valueType = Nothing, fields = [Field "transferNeedId" Nothing, Field "region" Nothing]},+                          resolve = ResolveDecl ResolveHole ["hospitalId"] ((.loc) ((.resolve) router))+                        }+                  )+                  (checkedSpec baseline)+              )+              baseline+          classifyCoordination old new = [(impact.reason, (.severity) impact) | impact <- coordinationImpact old new []]+      case routerSelectionSnapshots baseline of+        [snapshot] -> do+          (.verification) snapshot `shouldBe` DeclarativeVerified+          (.identity) snapshot `shouldBe` Just "hospital-transfer-selection"+          (.version) snapshot `shouldBe` Just 1+          fmap T.length ((.fingerprint) snapshot) `shouldBe` Just 64+          Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot+        snapshots -> expectationFailure ("expected one router selection ledger snapshot, got " <> show snapshots)+      classifyCoordination baseline identityChanged `shouldBe` [(SelectionIdentityChanged, CoordinationBreaking)]+      classifyCoordination versionTwo baseline `shouldBe` [(SelectionVersionDecreased, CoordinationBreaking)]+      classifyCoordination baseline fingerprintChanged `shouldBe` [(SelectionFingerprintChangedWithoutVersionBump, CoordinationBreaking)]+      classifyCoordination baseline versionedFingerprintChanged `shouldBe` [(SelectionFingerprintChangedWithVersionBump, CoordinationAdvisory)]+      classifyCoordination baseline versionTwo `shouldBe` [(SelectionVersionMetadataOnly, CoordinationAdvisory)]+      classifyCoordination baseline custom `shouldBe` [(SelectionVerificationBoundaryChanged, CoordinationAdvisory)]+      let breakingReport = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReportWithImpacts defaultGate [] [] (coordinationImpact baseline fingerprintChanged []))))+      breakingReport `shouldSatisfy` T.isInfixOf "\"breaking\":true"++    it "keeps formatting out of the fingerprint and reports mapped selection dependencies in both sections" $ do+      source <- readTestText "test/fixtures/declarative-router/valid.keiro"+      baseline <- checkedServiceFromText "selection-semantic-baseline.keiro" source+      formatted <- checkedServiceFromText "selection-semantic-formatted.keiro" (T.replace "context transfer-routing\n" "context transfer-routing\n\n" source)+      coordinationImpact baseline formatted [] `shouldBe` []+      let changed = checkedServiceWithSpec (mapMappedStructural "HospitalLoadRow" changeMappedCanonical (checkedSpec baseline)) baseline+          semantic = CheckedDiff.mappedSemanticImpactForServices baseline changed+          coordination = coordinationImpact baseline changed semantic+          rowDelta = find ((== MappedKey "HospitalLoadRow") . (.declaration)) semantic+          rendered = T.unlines (renderCoordinationImpact coordination)+          encoded = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReportWithImpacts defaultGate [] semantic coordination)))+          isSelectionConsumer = \case RouterSelectionConsumer {} -> True; _ -> False+      rowDelta `shouldSatisfy` maybe False (any isSelectionConsumer . Set.toList . (.currentConsumers))+      map (.reason) coordination `shouldContain` [SelectionMappedDependencyChanged]+      rendered `shouldSatisfy` T.isInfixOf "selection-mapped-dependency-changed"+      encoded `shouldSatisfy` T.isInfixOf "\"coordinationImpact\""+      encoded `shouldSatisfy` T.isInfixOf "router-selection:HospitalTransferRouter:recipient"+      LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReport defaultGate [])))+        `shouldNotSatisfy` T.isInfixOf "coordinationImpact"++    it "RouterSelection gates declarative selection at the version-5 marker" $ do+      source <- readTestText "test/fixtures/declarative-router/valid.keiro"+      let version4 = "language keiro-dsl 4\ncontext transfer-routing\n\n" <> snd (T.breakOn "router HospitalTransferRouter" source)+      case parseSurfaceSource "declarative-router-v4.keiro" version4 of+        Left FrontendFailure {code = SourceLanguageError LanguageFeatureRequiresVersion, span = SourceSpan {start = SourcePoint {offset = startOffset}, end = SourcePoint {offset = endOffset}}} ->+          T.take (endOffset - startOffset) (T.drop startOffset version4) `shouldBe` "declarative"+        Left failure -> expectationFailure (show failure)+        Right _ -> expectationFailure "language 4 unexpectedly accepted declarative selection"++    it "RouterSelection rejects unbounded selection at its declaration" $ do+      diagnostics <- diagnosticsOf "test/fixtures/declarative-router/unbounded.keiro"+      [((.line) diagnostic, (.code) diagnostic) | diagnostic <- diagnostics, (.severity) diagnostic == Error]+        `shouldBe` [(79, RouterSelectionRecipientLimitMissing)]++    it "RouterSelection assigns a dedicated diagnostic to every declarative selection rejection class" $ do+      source <- readTestText "test/fixtures/declarative-router/valid.keiro"+      let mutationCases =+            [ ("empty-identity", T.replace "identity = \"hospital-transfer-selection\"" "identity = \"\"", RouterSelectionIdentityEmpty),+              ("zero-version", T.replace "version = 1" "version = 0", RouterSelectionVersionInvalid),+              ("unknown-query", T.replace "read-model hospital_load" "read-model missing_load", RouterSelectionQueryUnknown),+              ("missing-query-contract", T.replace "  query input = TransferRouteInput\n  query result = List HospitalLoadRow\n" "", RouterSelectionQueryContractMissing),+              ("input-mismatch", T.replace "input AcceptedHospitalTransferNeed : TransferRouteInput" "input AcceptedHospitalTransferNeed : HospitalLoadRow", RouterSelectionQueryInputTypeMismatch),+              ("non-list-result", T.replace "query result = List HospitalLoadRow" "query result = HospitalLoadRow", RouterSelectionQueryResultNotList),+              ("unknown-root", T.replace "recipient = row.hospitalId" "recipient = resolved.hospitalId", RouterSelectionExpressionRootUnknown),+              ("unknown-field", T.replace "recipient = row.hospitalId" "recipient = row.missingHospitalId", RouterSelectionExpressionFieldUnknown),+              ("nullable-recipient", T.replace ": Text required\n    region" ": Optional Text required\n    region", RouterSelectionExpressionFieldOptional),+              ("predicate-type", T.replace "where = row.region == input.region && row.availableBeds > 0" "where = row.region", RouterSelectionPredicateNotBool),+              ("recipient-type", T.replace "recipient = row.hospitalId" "recipient = row.availableBeds", RouterSelectionRecipientNotText),+              ("operator", T.replace "recipient = row.hospitalId" "recipient = row.availableBeds + 1", RouterSelectionOperatorUnsupported),+              ("zero-limit", T.replace "max-recipients = 64" "max-recipients = 0", RouterSelectionRecipientLimitInvalid),+              ("order", T.replace "order = target-stream" "order = query-order", RouterSelectionOrderUnsupported),+              ("dedupe", T.replace "dedupe = target-stream" "dedupe = none", RouterSelectionDedupeUnsupported),+              ("failure-ack", T.replace "failure => retry" "failure => ack", RouterSelectionFailureAckForbidden),+              ("redelivery", T.replace "redelivery = stable-union" "redelivery = replace", RouterSelectionRedeliveryUnsupported),+              ("partial", T.replace "partial = retain-successes" "partial = rollback", RouterSelectionPartialDispatchUnsupported),+              ("target", T.replace "target Hospital\n" "target MissingHospital\n", RouterSelectionTargetAmbiguous),+              ("command", T.replace "dispatch-each RouteAcceptedTransferNeed" "dispatch-each MissingCommand", RouterSelectionCommandUnknown),+              ("duplicate-field", T.replace "    hospitalId=row.hospitalId\n" "    hospitalId=row.hospitalId\n    hospitalId=row.hospitalId\n", RouterSelectionCommandMappingDuplicate),+              ("incomplete-field", T.replace "    hospitalId=row.hospitalId\n" "", RouterSelectionCommandMappingIncomplete),+              ("field-type", T.replace "hospitalId:Text" "hospitalId:Int", RouterSelectionCommandMappingTypeMismatch)+            ]+      forM_ mutationCases $ \(caseLabel, mutate, expected) -> do+        service <- checkedServiceFromText ("declarative-router-" <> caseLabel <> ".keiro") (mutate source)+        [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]+          `shouldContain` [expected]++    it "parses the incident-paging router shape" $ do+      input <- readTestText "test/fixtures/incident-paging/incident-paging.keiro"+      case parseSpec "test/fixtures/incident-paging/incident-paging.keiro" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> case [router | NRouter router <- (.nodes) spec] of+          [router] -> do+            router.id `shouldBe` "PagingRouter"+            (.name) router `shouldBe` "jitsurei-paging"+            (.field) ((.key) router) `shouldBe` "incidentId"+            (.source) ((.resolve) router) `shouldBe` ResolveReadModel "service_oncall"+            (.row) ((.resolve) router) `shouldBe` ["responderId"]+            (.command) ((.dispatch) router) `shouldBe` "SendPage"+            (.rejected) router `shouldBe` PolDeadLetter+            (.poison) router `shouldBe` PolHalt+          routers -> expectationFailure ("expected one router, got " <> show (length routers))+    it "round-trips the incident-paging spec through parse . pretty" $ do+      input <- readTestText "test/fixtures/incident-paging/incident-paging.keiro"+      case parseSpec "in" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> parseLanguage4RenderedSpec "in" spec `shouldBe` Right spec+    it "accepts the incident-paging router with warnings only" $ do+      codes <- errorCodesOf "test/fixtures/incident-paging/incident-paging.keiro"+      codes `shouldBe` []+      diagnostics <- diagnosticCodesOf "test/fixtures/incident-paging/incident-paging.keiro"+      diagnostics `shouldContain` [PolicyDeadLetterUnused, AmbiguousFollowsRejectedPolicy]+    it "rejects unresolved targets, keys, commands, and binding scopes" $ do+      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      routerErrorCodes (routerWithTarget "Pge") spec `shouldContain` [RouterUnresolvedRef]+      routerErrorCodes (\router -> routerWithKey (correlateDeclWithField "incidntId" router.key) router) spec `shouldContain` [RouterKeyFieldUnknown]+      routerErrorCodes (\router -> routerWithDispatch (routerDispatchWithCommand "SendPag" router.dispatch) router) spec `shouldContain` [RouterCommandUnknown]+      routerErrorCodes+        ( \router ->+            let dispatch = router.dispatch+             in routerWithDispatch (routerDispatchWithFields [FieldBinding "responderId" (Just "resolved.responder")] dispatch) router+        )+        spec+        `shouldContain` [RouterBindingUnscoped]+    it "rejects unresolved read models and contradictory rejection policies" $ do+      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      let withoutReadModel = removeReadModel "service_oncall" spec+      errorCodes withoutReadModel `shouldContain` [RouterUnresolvedRef]+      routerErrorCodes+        ( \router ->+            let dispatch = router.dispatch+                disposition = dispatch.disposition+             in routerWithRejectedAndDispatch+                  PolHalt+                  (routerDispatchWithDisposition (dispatchDispositionWithOnFailed (DDeadLetter "page rejected") disposition) dispatch)+                  router+        )+        spec+        `shouldContain` [PolicyContradiction]+    it "gates resolve-row column verification on language 4" $ do+      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      let unresolved =+            modifyRouter+              "PagingRouter"+              (\router -> routerWithResolve (resolveDeclWithRow ["ghostColumn"] router.resolve) router)+              spec+      serviceErrorCodes 3 unresolved `shouldNotContain` [RouterReadModelUnverified]+      serviceErrorCodes 4 unresolved `shouldContain` [RouterReadModelUnverified]+      serviceErrorCodes 4 spec `shouldNotContain` [RouterReadModelUnverified]+    it "rejects on-ambiguous Fired for process timers" $ do+      spec <- specOf "test/fixtures/hospital-surge.keiro"+      let changed =+            specWithNodes+              [ case node of+                  NProcess process ->+                    let timer = legacyProcessTimer process+                        fire = timer.fire+                        disposition = fire.disposition+                     in NProcess+                          ( processWithTimer+                              (timerWithFire (fireNodeWithDisposition (fireDispositionWithOnAmbiguous OFired disposition) fire) timer)+                              process+                          )+                  _ -> node+              | node <- spec.nodes+              ]+              spec+      errorCodes changed `shouldContain` [AmbiguousMarkedBenign]+    it "requires explicit policy and ambiguity clauses in the grammar" $ do+      source <- readTestText "test/fixtures/hospital-surge.keiro"+      parseSpec "<missing-poison>" (T.replace "  poison => halt\n" "" source) `shouldSatisfy` isLeft+      parseSpec "<missing-ambiguous>" (T.replace " ; on-ambiguous Retry" "" source) `shouldSatisfy` isLeft+    it "scaffolds firewall-clean router wiring, policies, and typed-hole guidance" $ do+      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      case [router | NRouter router <- (.nodes) spec] of+        [router] -> do+          let ctx = defaultContext (spec.context)+              modules = scaffoldRouter ctx router+              generated = [m | m <- modules, (.kind) m == Generated]+              holes = [m | m <- modules, (.kind) m == HoleStub]+          firewallBreaches generated `shouldBe` []+          case (generated, holes) of+            ([generatedModule], [moduleName]) -> do+              (.text) generatedModule `shouldSatisfy` T.isInfixOf "pagingRouterWorkerOptions"+              (.text) generatedModule `shouldSatisfy` T.isInfixOf "rejectedCommandPolicy = RejectedDeadLetter"+              (.text) moduleName `shouldSatisfy` T.isInfixOf "UNION of resolved target identities"+              (.text) moduleName `shouldSatisfy` T.isInfixOf "confirmBenignDuplicate"+            _ -> expectationFailure "expected one generated router module and one router hole module"+        routers -> expectationFailure ("expected one router, got " <> show (length routers))+    it "requires a caller callback for non-halting poison policies" $ do+      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      case [router | NRouter router <- (.nodes) spec] of+        [router] -> do+          let ctx = defaultContext (spec.context)+              generatedFor choice = [(.text) m | m <- scaffoldRouter ctx (routerWithPoison choice router), (.kind) m == Generated]+          mapM_+            ( \(choice, constructor) -> case generatedFor choice of+                [generatedModule] -> do+                  generatedModule `shouldSatisfy` T.isInfixOf "(Envelope msg -> Eff es ()) -> WorkerOptions es msg"+                  generatedModule `shouldSatisfy` T.isInfixOf (constructor <> " poisonCallback")+                _ -> expectationFailure "expected one generated router module"+            )+            [(PolDeadLetter, "PoisonDeadLetter"), (PolSkip, "PoisonSkip")]+          case [(.text) m | m <- scaffoldRouter ctx (routerWithRejected PolSkip router), (.kind) m == Generated] of+            [generatedModule] -> generatedModule `shouldSatisfy` T.isInfixOf "rejectedCommandPolicy = RejectedSkip"+            _ -> expectationFailure "expected one generated router module"+        routers -> expectationFailure ("expected one router, got " <> show (length routers))+    it "emits router harness facts that pin policy and target-keyed identity" $ do+      spec <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      case [router | NRouter router <- (.nodes) spec] of+        [router] -> case harnessRouter (defaultContext (spec.context)) router of+          [facts] -> do+            (.text) facts `shouldSatisfy` T.isInfixOf "(\"rejectedPolicy\", \"deadLetter\")"+            (.text) facts `shouldSatisfy` T.isInfixOf "targetStreamName, occurrence"+          modules -> expectationFailure ("expected one router harness, got " <> show (length modules))+        routers -> expectationFailure ("expected one router, got " <> show (length routers))+    it "rejects invalid timer ceilings and target field bindings" $ do+      codes <- errorCodesOf "test/fixtures/process-bad-timer.keiro"+      mapM_+        (\expected -> codes `shouldContain` [expected])+        [ProcessTimerCeilingInvalid, ProcessFieldBindingUnresolved]+    it "accepts resolved process projection references" $ do+      codes <- errorCodesOf "test/fixtures/surge-service.keiro"+      codes `shouldBe` []+    it "scaffolds the process: Generated wiring is firewall-clean + a HoleStub" $ do+      mods <- legacyScaffoldProcessFixture "test/fixtures/hospital-surge.keiro"+      let gens = [m | m <- mods, (.kind) m == Generated]+          holes = [m | m <- mods, (.kind) m == HoleStub]+      length holes `shouldBe` 1+      firewallBreaches gens `shouldBe` []+      case gens of+        [generatedModule] -> do+          -- the worker uses the spec's ceiling, never the dangerous default+          (.text) generatedModule `shouldSatisfy` T.isInfixOf "max-attempts = 5"+          (.text) generatedModule `shouldSatisfy` T.isInfixOf "hospitalSurgeProcessWorkerOptions"+          (.text) generatedModule `shouldSatisfy` T.isInfixOf "import Generated.HospitalCapacity.Surge.EventStream (SurgeEventStreamDef)"+          (.text) generatedModule `shouldSatisfy` T.isInfixOf "hospitalSurgeCategory :: Stream.StreamCategory SurgeEventStreamDef"+          (.text) generatedModule `shouldSatisfy` T.isInfixOf "hospitalSurgeCategory = Stream.categoryUnsafe \"hospitalSurge\""+          (.text) generatedModule `shouldSatisfy` T.isInfixOf "confirmBenignDuplicate"+          (.text) generatedModule `shouldSatisfy` T.isInfixOf "StreamName -> EventId -> CommandError -> Eff es Bool"+          (.text) generatedModule `shouldSatisfy` T.isInfixOf "Left (CommandAmbiguous _)"+          case holes of+            [moduleName] -> (.text) moduleName `shouldSatisfy` T.isInfixOf "entityStream hospitalSurgeCategory"+            _ -> expectationFailure "expected one process hole module"+        _ -> expectationFailure "expected one generated process module"+    it "process scaffold is deterministic" $ do+      a <- legacyScaffoldProcessFixture "test/fixtures/hospital-surge.keiro"+      b <- legacyScaffoldProcessFixture "test/fixtures/hospital-surge.keiro"+      map (.text) a `shouldBe` map (.text) b+    it "separates aggregate event-stream and command-target categories and emits stable typed sums" $ do+      spec <- specOf "test/fixtures/hospital-surge.keiro"+      let ctx = defaultContext (spec.context)+          modules = concat [scaffoldAggregate ctx spec aggregate | NAggregate aggregate <- (.nodes) spec]+          surgeStream = generatedTextEndingIn "Surge/EventStream.hs" modules+          surgeDomain = generatedTextEndingIn "Surge/Domain.hs" modules+      surgeStream `shouldSatisfy` T.isInfixOf "surgeCategory :: Stream.StreamCategory SurgeEventStreamDef"+      surgeStream `shouldSatisfy` T.isInfixOf "surgeCommandCategory :: Stream.StreamCategory SurgeCommand"+      surgeDomain `shouldNotSatisfy` T.isInfixOf "{-# LANGUAGE EmptyDataDecls #-}"+      surgeDomain `shouldSatisfy` T.isInfixOf "data SurgeEvent = SurgeThresholdNoted"+      surgeDomain `shouldSatisfy` (not . T.isInfixOf "data SurgeEvent = ()")++  describe "contract (EP-4)" $ do+    it "parses the emergency contract (topics + events-on-topic + typed fields)" $ do+      input <- readTestText "test/fixtures/contract.keiro"+      case parseSpec "test/fixtures/contract.keiro" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> case [c | NContract c <- (.nodes) spec] of+          (c : _) -> do+            (.name) c `shouldBe` "emergency"+            (.discriminator) c `shouldBe` "messageType"+            map fst ((.topics) c) `shouldBe` ["incidentEvents", "hospitalEvents"]+            map (.name) ((.events) c) `shouldBe` ["IncidentTransferNeedDeclared", "TransferReservationAccepted"]+          [] -> expectationFailure "no contract node parsed"++    it "lowers generated and consumer-bound declared IDs from the checked contract graph" $ do+      sourceText <- readTestText "test/fixtures/contract-declared-id.keiro"+      parsed <- case parseSource "contract-declared-id.keiro" sourceText of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let service = checkedSource parsed+          spec = checkedSpec service+          ctx = defaultContext (spec.context)+          modules = scaffoldServiceModules ctx service+          contractModule = generatedTextEndingIn "Templates/Contract.hs" modules+          leafModule = generatedTextEndingIn "Structural/NominalLeaves.hs" modules+      validateService service `shouldBe` []+      contractModule `shouldSatisfy` T.isInfixOf "templateId :: !Nominals.TemplateId"+      contractModule `shouldSatisfy` T.isInfixOf "claimId :: !ClaimId"+      contractModule `shouldSatisfy` T.isInfixOf "NominalLeaves.encodeTemplateIdLeaf payload.templateId"+      contractModule `shouldSatisfy` T.isInfixOf "explicitParseField NominalLeaves.parseClaimIdLeaf o \"claimId\""+      leafModule `shouldSatisfy` T.isInfixOf "parseTemplateIdLeaf :: Value -> Parser Nominals.TemplateId"+      leafModule `shouldSatisfy` T.isInfixOf "nominalFromRepresentation Bindings.claimIdBinding"+      idDomainIdentitiesForService service+        `shouldContain` [ "id-domain|name=contract:templates.TemplateClaimed.templateId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=template|separator=_|json=canonical-json-text",+                          "id-domain|name=contract:templates.TemplateClaimed.claimId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=claim|separator=_|json=canonical-json-text"+                        ]+      obligations <- case bindingObligationsForService service of+        Left failures -> expectationFailure (show failures) >> fail "unreachable"+        Right values -> pure values+      [site | obligation <- obligations, (.mappedName) obligation == "ClaimId", site <- (.useSites) obligation]+        `shouldContain` ["contract templates event TemplateClaimed .claimId : ClaimId"]++    it "rejects non-ID declarations in declared-ID contract fields" $ do+      let sourceText =+            T.unlines+              [ "language keiro-dsl 6",+                "context contract-declared-id-invalid",+                "enum Channel { Email=email }",+                "contract templates {",+                "  schemaVersion 1",+                "  discriminator kind",+                "  topic events \"templates.events\"",+                "  event TemplateChanged on events { channel: Channel }",+                "}"+              ]+      service <- checkedServiceFromText "contract-declared-id-invalid.keiro" sourceText+      case [diagnostic | diagnostic <- validateService service, (.code) diagnostic == ContractIdUnknown] of+        [diagnostic] -> (.message) diagnostic `shouldSatisfy` T.isInfixOf "is an enum; contract declared-ID fields must name a declared id"+        diagnostics -> expectationFailure ("expected one ContractIdUnknown diagnostic, got " <> show diagnostics)++    it "branches contract scaffolding, manifests, and durable identities only for language 4" $ do+      sourceText <- readTestText "test/fixtures/contract-v4.keiro"+      parsed <- case parseSource "contract-v4.keiro" sourceText of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let service = checkedSource parsed+          spec = checkedSpec service+          ctx = defaultContext (spec.context)+      contract <- case [value | NContract value <- (.nodes) spec] of+        [value] -> pure value+        values -> expectationFailure ("expected one contract, got " <> show (length values)) >> fail "unreachable"+      legacyModule <- case scaffoldContract ctx contract of+        [value] -> pure value+        values -> expectationFailure ("expected one legacy module, got " <> show (length values)) >> fail "unreachable"+      typedModule <- case scaffoldContractForService ctx service contract of+        [value] -> pure value+        values -> expectationFailure ("expected one typed module, got " <> show (length values)) >> fail "unreachable"+      let dependencies = manifestDependenciesForService service+          identities = idDomainIdentitiesForService service+          manifestText = renderManifestForService "contract-v4.keiro" [typedModule] service+      assertGeneratedHaskellContract "contract-v4.keiro" manifestText+      committed <- readTestText "test/conformance-contract/Generated/HospitalCapacity/Emergency/Contract.hs"+      normalizeGenerated ((.text) typedModule) `shouldBe` normalizeGenerated committed+      (.text) legacyModule `shouldSatisfy` T.isInfixOf "incidentId :: !Text"+      (.text) legacyModule `shouldSatisfy` (not . T.isInfixOf "KindID")+      (.text) typedModule `shouldSatisfy` T.isInfixOf "incidentId :: !(KindID \"inc\")"+      (.text) typedModule `shouldSatisfy` T.isInfixOf "KindID.toText payload.incidentId"+      (.text) typedModule `shouldSatisfy` T.isInfixOf "explicitParseField (parseKindIdV7Value @\"inc\") o \"incidentId\""+      (.text) typedModule `shouldSatisfy` T.isInfixOf "  , incidentEventsTopic"+      (.text) typedModule `shouldSatisfy` T.isInfixOf "  , hospitalEventsTopic"+      (.text) typedModule `shouldSatisfy` (not . T.isInfixOf "Wno-unused-top-binds")+      dependencies `shouldBe` ["aeson", "base", "keiro-core", "mmzk-typeid", "text"]+      manifestDependencies spec `shouldBe` ["aeson", "base", "text"]+      forM_ dependencies $ \dependency -> manifestText `shouldSatisfy` T.isInfixOf ("    , " <> dependency)+      identities+        `shouldBe` [ "id-domain|name=contract:emergency.IncidentTransferNeedDeclared.incidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text",+                     "id-domain|name=contract:emergency.TransferReservationAccepted.incidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text",+                     "id-domain|name=contract:emergency.TransferReservationAccepted.reservationId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=rsv|separator=_|json=canonical-json-text",+                     "id-domain|name=contract:emergency.TransferReservationAccepted.hospitalId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=hsp|separator=_|json=canonical-json-text"+                   ]++    it "persists contract ID domains in single-file and workspace records with owner attribution" $ do+      sourceText <- readTestText "test/fixtures/contract-v4.keiro"+      parsed <- case parseSource "contract-v4.keiro" sourceText of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right value -> pure value+      let service = checkedSource parsed+          spec = checkedSpec service+          ctx = defaultContext (spec.context)+          modules = scaffoldServiceModules ctx service+          identities = idDomainIdentitiesForService service+      duplicateIdentity <- case identities of+        value : _ -> pure value+        [] -> expectationFailure "typed contract service did not expose ID-domain identities" >> fail "unreachable"+      withTempDirectory "keiro-dsl-v4-contract-record" $ \out -> do+        result <- executeServiceScaffold out False "contract-v4.keiro" ((.sourceLanguage) parsed) ctx service modules+        result `shouldSatisfy` isRight+        contents <- TIO.readFile (out </> recordFileName (spec.context))+        record <- maybe (expectationFailure "typed contract scaffold record did not parse" >> fail "unreachable") pure (parseRecord contents)+        (.idDomains) record `shouldBe` identities+        parseRecord (contents <> "id-domain " <> duplicateIdentity <> "\n") `shouldBe` Nothing++      let manifest = "service hospital-capacity\nspec domain/contract.keiro\n"+          source = memoryContentSource (Map.fromList [("service.keiro-workspace", manifest), ("domain/contract.keiro", sourceText)])+      loaded <- loadWorkspace source "service.keiro-workspace"+      workspace <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure loaded+      workspacePlan <- either (\refusals -> expectationFailure (show refusals) >> fail "unreachable") pure (planWorkspaceScaffold "goldens" ctx workspace)+      case [provenance | (scaffoldModule, provenance) <- workspacePlan.modules, (.path) scaffoldModule == "Generated/HospitalCapacity/Emergency/Contract.hs"] of+        [MemberOwned owner] -> owner `shouldBe` "domain/contract.keiro"+        values -> expectationFailure ("expected one member-owned contract module, got " <> show values)+      withTempDirectory "keiro-dsl-v4-contract-workspace-record" $ \out -> do+        result <- executeWorkspaceScaffold out False workspacePlan+        result `shouldSatisfy` isRight+        contents <- TIO.readFile (out </> workspaceRecordFileName (workspace.service))+        record <- maybe (expectationFailure "typed contract workspace record did not parse" >> fail "unreachable") pure (parseWorkspaceRecord contents)+        (.idDomains) record `shouldBe` identities+        [((.path) row, (.owner) row) | row <- record.modules, (.path) row == "Generated/HospitalCapacity/Emergency/Contract.hs"]+          `shouldBe` [("Generated/HospitalCapacity/Emergency/Contract.hs", Just "domain/contract.keiro")]+        parseWorkspaceRecord (contents <> "id-domain " <> duplicateIdentity <> "\n") `shouldBe` Nothing+    it "round-trips the contract spec through parse . pretty" $ do+      input <- readTestText "test/fixtures/contract.keiro"+      case parseSource "in" input of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right source -> parseSource "in" (renderSource source) `shouldBe` Right source+    it "round-trips the intake (inbox) spec through parse . pretty" $ do+      input <- readTestText "test/fixtures/intake.keiro"+      case parseSpec "in" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> parseSpec "in" (renderSpec spec) `shouldBe` Right spec+    it "accepts the intake spec (complete disposition, no inversions)" $ do+      codes <- errorCodesOf "test/fixtures/intake.keiro"+      codes `shouldBe` []+    it "gates delegated intake to Language 6 and round-trips the explicit mode" $ do+      input <- readTestText "test/fixtures/intake-delegated.keiro"+      parsed <- case parseSource "intake-delegated.keiro" input of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right source -> pure source+      let rendered = renderSource parsed+      rendered `shouldSatisfy` T.isInfixOf "idempotence delegated"+      parseSource "intake-delegated-roundtrip.keiro" rendered `shouldBe` Right parsed+      case parseSource "intake-delegated-v5.keiro" (T.replace "language keiro-dsl 6" "language keiro-dsl 5" input) of+        Left (SourceLanguageFailure diagnostic) -> (.errorCode) diagnostic `shouldBe` LanguageFeatureRequiresVersion+        other -> expectationFailure ("expected a Language 5 feature refusal, got " <> show other)+    it "generates a delegated runner while preserving published table bytes" $ do+      delegated <- specOf "test/fixtures/intake-delegated.keiro"+      publishedInput <- readTestText "test/fixtures/intake.keiro"+      candidateTable <- case parseSpec "intake-table-v6.keiro" (T.replace "language keiro-dsl 4" "language keiro-dsl 6" publishedInput) of+        Left failure -> expectationFailure (T.unpack failure) >> fail "unreachable"+        Right value -> pure value+      let oneInbox spec = case [intake | NIntake intake <- (.nodes) spec] of+            [intake] -> intake+            values -> error ("expected one intake, got " <> show (length values))+          delegatedIntake = oneInbox delegated+          delegatedModule = generatedTextEndingIn "Inbox.hs" (scaffoldIntake (defaultContext (delegated.context)) delegatedIntake)+          publishedSpec = either (error . T.unpack) id (parseSpec "intake-v4.keiro" publishedInput)+          publishedModule = generatedTextEndingIn "Inbox.hs" (scaffoldIntake (defaultContext (publishedSpec.context)) (oneInbox publishedSpec))+          candidateModule = generatedTextEndingIn "Inbox.hs" (scaffoldIntake (defaultContext (candidateTable.context)) (oneInbox candidateTable))+      (.idempotence) delegatedIntake `shouldBe` IdemDelegated+      delegatedModule `shouldSatisfy` T.isInfixOf "runInboxIntake metrics event delivery ="+      delegatedModule `shouldSatisfy` T.isInfixOf "runInboxDelegated metrics inboxDedupePolicy event delivery"+      delegatedModule `shouldSatisfy` T.isInfixOf "inboxIdempotence = IdempotenceDelegated"+      delegatedModule `shouldNotSatisfy` T.isInfixOf "inboxPersistence"+      candidateModule `shouldBe` publishedModule+    it "rejects dedupe-only persistence in delegated mode and reports mode flips as breaking" $ do+      tableSpec <- specOf "test/fixtures/intake.keiro"+      let delegated = mapIntake (intakeWithIdempotence IdemDelegated) tableSpec+      errorCodes delegated `shouldContain` [DelegatedInboxDedupeOnlyPersistence]+      [(.code) change | Breaking change <- diffSpecs tableSpec delegated]+        `shouldContain` [IntakeIdempotenceModeChanged]+    it "warns when intake bind flags describe unenforced generated behavior" $ do+      codes <- diagnosticCodesOf "test/fixtures/intake.keiro"+      codes `shouldContain` [IntakeBindFlagUnenforced]+    it "lowers explicit dedupe-only persistence and defaults omission to full-envelope" $ do+      spec <- specOf "test/fixtures/intake.keiro"+      ordinary <- specOf "test/fixtures/intake-decode.keiro"+      case ([intake | NIntake intake <- (.nodes) spec], [intake | NIntake intake <- (.nodes) ordinary]) of+        ([intake], [defaultIntake]) -> do+          (.persist) intake `shouldBe` InkPersistDedupeOnly+          (.persist) defaultIntake `shouldBe` InkPersistFull+          renderSpec spec `shouldSatisfy` T.isInfixOf "persist = dedupe-only"+          renderSpec ordinary `shouldNotSatisfy` T.isInfixOf "persist ="+          let inbox = generatedTextEndingIn "Inbox.hs" (scaffoldIntake (defaultContext (spec.context)) intake)+          inbox `shouldSatisfy` T.isInfixOf "inboxPersistence = PersistDedupeOnly"+          inbox `shouldSatisfy` T.isInfixOf "data IncidentInboxOutcome"+          inbox `shouldSatisfy` T.isInfixOf "data IncidentInboxDisposition"+          inbox `shouldSatisfy` T.isInfixOf "InboxRetryAfter !RetryDelay !(Maybe InboxFailure)"+          inbox `shouldSatisfy` T.isInfixOf "InboxDeadLetter !(Maybe Text) !(Maybe InboxFailure)"+          inbox `shouldSatisfy` T.isInfixOf "InboxHandlerFailed reason attempts ->"+          inbox `shouldNotSatisfy` T.isInfixOf "Nothing -> InboxRetry"+        (intakes, defaultIntakes) ->+          expectationFailure ("expected one intake in each fixture, got " <> show (length intakes, length defaultIntakes))+    it "rejects duplicate => retry (inversion 1)" $ do+      codes <- errorCodesOf "test/fixtures/intake-dup-retry.keiro"+      codes `shouldContain` [DispositionDuplicateRetry]+    it "rejects previouslyFailed => retry (inversion 2)" $ do+      codes <- errorCodesOf "test/fixtures/intake-pf-retry.keiro"+      codes `shouldContain` [DispositionPreviouslyFailedRetry]+    it "rejects an incomplete disposition table" $ do+      codes <- errorCodesOf "test/fixtures/intake-incomplete.keiro"+      codes `shouldContain` [DispositionIncomplete]+    it "rejects a shadowing duplicate intake disposition row" $ do+      codes <- errorCodesOf "test/fixtures/intake-dup-row.keiro"+      codes `shouldContain` [DispositionDuplicateOutcome]+    it "rejects intake events declared on another topic" $ do+      codes <- errorCodesOf "test/fixtures/intake-topic-mismatch.keiro"+      codes `shouldContain` [TopicAffinityMismatch]+    it "round-trips the emit/publisher spec through parse . pretty" $ do+      input <- readTestText "test/fixtures/emit.keiro"+      case parseSpec "in" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> parseSpec "in" (renderSpec spec) `shouldBe` Right spec+    it "accepts the emit/publisher spec (skip present, coupling resolves)" $ do+      codes <- errorCodesOf "test/fixtures/emit.keiro"+      codes `shouldBe` []+    -- `derive … hole` is mandatory emit grammar, so a diagnostic saying it+    -- generates nothing would fire on every emit node in every spec and could+    -- never be resolved. It is the scaffold report's inert-node line (asserted+    -- immediately below) that carries the fact, once per run. See ExecPlan 199.+    it "leaves an emit-bearing spec clean enough for --deny-warnings" $ do+      (exitCode, out, err) <- runKeiroDsl ["check", "test/fixtures/emit.keiro", "--deny-warnings"]+      unless (exitCode == ExitSuccess) (expectationFailure (out <> err))+      err `shouldNotContain` "escalated to failure"+    it "reports emit nodes that contribute no generated modules" $+      withTempDirectory "keiro-dsl-inert-report" $ \out -> do+        spec <- specOf "test/fixtures/emit.keiro"+        report <- executePlannedScaffold out "test/fixtures/emit.keiro" (defaultContext (spec.context)) spec+        (.inertNodes) report `shouldBe` [("emit", "reservationResponse")]+        renderScaffoldReport report+          `shouldSatisfy` any+            ( T.isInfixOf+                "no-modules: emit reservationResponse (validated and diff-classified; no generated modules)"+            )+    it "rejects a missing _ => skip catch-all as EmitSkipMissing" $ do+      codes <- errorCodesOf "test/fixtures/emit-noskip.keiro"+      codes `shouldContain` [EmitSkipMissing]+    it "rejects mapping to an undeclared contract event as EmitUnresolvedContract" $ do+      codes <- errorCodesOf "test/fixtures/emit-badevent.keiro"+      codes `shouldContain` [EmitUnresolvedContract]+    it "rejects emit events declared on another topic" $ do+      codes <- errorCodesOf "test/fixtures/emit-topic-mismatch.keiro"+      codes `shouldContain` [TopicAffinityMismatch]++  describe "pgmq workqueue/dispatch (EP-5)" $ do+    it "round-trips the reservation-work spec through parse . pretty" $ do+      input <- readTestText "test/fixtures/reservation-work.keiro"+      case parseSpec "in" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> parseSpec "in" (renderSpec spec) `shouldBe` Right spec+    it "round-trips fifo-heads and lowers it to the grouped-head runtime strategy" $ do+      input <- readTestText "test/fixtures/workqueue-fifo-heads.keiro"+      case parseSource "in" input of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+        Right parsed -> do+          renderSource parsed `shouldSatisfy` T.isInfixOf "ordering fifo-heads"+          parseSource "in" (renderSource parsed) `shouldBe` Right parsed+          case [workqueue | NWorkqueue workqueue <- (.nodes) ((.spec) parsed)] of+            [workqueue] -> do+              let policy = generatedTextEndingIn "QueuePolicy.hs" (scaffoldWorkqueue (defaultContext (((.spec) parsed).context)) workqueue)+              policy `shouldSatisfy` T.isInfixOf "jobOrdering = FifoHeads"+              policy `shouldSatisfy` T.isInfixOf "withFifoIndexProvision (standardProvision)"+            queues -> expectationFailure ("unexpected fifo-heads workqueues: " <> show queues)+    it "gates ordering fifo-heads at the token before Language 6" $ do+      source <- readTestText "test/fixtures/workqueue-fifo-heads.keiro"+      forM_ [4 :: Int, 5] $ \predecessor -> do+        let downgraded = T.replace "language keiro-dsl 6" ("language keiro-dsl " <> T.pack (show predecessor)) source+        case parseSurfaceSource "workqueue-fifo-heads-predecessor.keiro" downgraded of+          Left failure@FrontendFailure {code = SourceLanguageError LanguageFeatureRequiresVersion, span = SourceSpan {start = SourcePoint {offset = startOffset}, end = SourcePoint {offset = endOffset}}} -> do+            T.take (endOffset - startOffset) (T.drop startOffset downgraded) `shouldBe` "fifo-heads"+            renderFrontendFailure failure `shouldSatisfy` T.isInfixOf "LanguageFeatureRequiresVersion"+            renderFrontendFailure failure `shouldSatisfy` T.isInfixOf "requires keiro-dsl language version 6"+          Left failure -> expectationFailure (show failure)+          Right _ -> expectationFailure ("Language " <> show predecessor <> " unexpectedly accepted ordering fifo-heads")+    it "accepts the reservation-work spec (physical matches, no inversions)" $ do+      codes <- errorCodesOf "test/fixtures/reservation-work.keiro"+      codes `shouldBe` []+    it "rejects a divergent captured physical name as WqPhysicalDivergence" $ do+      codes <- errorCodesOf "test/fixtures/reservation-work-divergent.keiro"+      codes `shouldContain` [WqPhysicalDivergence]+    it "rejects storeFailure => deadLetter as WqStoreFailureNotRetry" $ do+      codes <- errorCodesOf "test/fixtures/reservation-work-sf-deadletter.keiro"+      codes `shouldContain` [WqStoreFailureNotRetry]+    it "rejects decodeFailure => retry as WqDecodeFailureNotDeadLetter" $ do+      codes <- errorCodesOf "test/fixtures/reservation-work-df-retry.keiro"+      codes `shouldContain` [WqDecodeFailureNotDeadLetter]+    it "requires complete, unique workqueue disposition rows" $ do+      incomplete <- errorCodesOf "test/fixtures/workqueue-incomplete.keiro"+      incomplete `shouldContain` [WqDispositionIncomplete]+      duplicateSpec <- specOf "test/fixtures/workqueue-dup-row.keiro"+      let duplicateDiagnostics = [d | d <- validateSpec duplicateSpec, (.code) d == DispositionDuplicateOutcome]+      map (.line) duplicateDiagnostics `shouldBe` [18]+    it "checks the captured queueRef dlq and table fixtures" $ do+      dlqCodes <- errorCodesOf "test/fixtures/workqueue-dlq-divergent.keiro"+      dlqCodes `shouldContain` [WqDlqDivergence]+      tableCodes <- errorCodesOf "test/fixtures/workqueue-table-divergent.keiro"+      tableCodes `shouldContain` [WqTableDivergence]+    it "matches queueRef for upper-case, punctuation, and hashed logical names" $ do+      upper <- errorCodesOf "test/fixtures/workqueue-uppercase-logical.keiro"+      upper `shouldBe` []+      hashed <- errorCodesOf "test/fixtures/workqueue-hashed-logical.keiro"+      hashed `shouldBe` []+      derivedQueueTrio "hospital_capacity.reservation_work.per_hospital_fifo_lane_assignments"+        `shouldBe` ( "hospital_capacity_reservat_757040df00976c33",+                     "hospital_capacity_reservat_757040df00976c33_dlq",+                     "pgmq.q_hospital_capacity_reservat_757040df00976c33"+                   )+    it "resolves dispatch dedup queues and payload wire fields" $ do+      ghost <- errorCodesOf "test/fixtures/dispatch-dedup-ghost-queue.keiro"+      ghost `shouldContain` [DispatchDedupQueueUnresolved]+      field <- errorCodesOf "test/fixtures/dispatch-dedup-bad-field.keiro"+      field `shouldContain` [DispatchDedupFieldUnresolved]+    it "requires a resolvable group key exactly when ordering is FIFO" $ do+      noKey <- errorCodesOf "test/fixtures/reservation-work-fifo-nokey.keiro"+      noKey `shouldContain` [WqGroupKeyMissing]+      unordered <- errorCodesOf "test/fixtures/reservation-work-key-unordered.keiro"+      unordered `shouldContain` [WqGroupKeyWithoutFifo]+      source <- readTestText "test/fixtures/reservation-work.keiro"+      unresolved <- parseInlineSpec "<unresolved-group-key>" (T.replace "group key from reservationId" "group key from missingId" source)+      map (.code) (validateSpec unresolved) `shouldContain` [WqGroupKeyUnresolved]+    it "warns on unlogged storage and rejects empty partition settings" $ do+      warningCodes <- diagnosticCodesOf "test/fixtures/reservation-work-unlogged.keiro"+      warningCodes `shouldContain` [WqUnloggedDurability]+      partitionCodes <- errorCodesOf "test/fixtures/reservation-work-partitioned-empty.keiro"+      partitionCodes `shouldContain` [WqPartitionSpecEmpty]+    -- Every payload field is required — generated decoders use `o .:` for all of+    -- them — so the marker no longer selects anything. A source that omits it and+    -- a source that writes it describe the same queue and produce identical+    -- output. See ExecPlan 199.+    it "treats a payload field as required whether or not the marker is written" $ do+      unmarkedSource <- readTestText "test/fixtures/reservation-work-optfield.keiro"+      let bare = "    note -> \"note\" text"+          markedSource = T.replace bare (bare <> " required") unmarkedSource+      unmarkedSource `shouldSatisfy` T.isInfixOf bare+      parseSpec "unmarked" unmarkedSource `shouldBe` parseSpec "marked" markedSource+      errorCodesOf "test/fixtures/reservation-work-optfield.keiro" >>= (`shouldBe` [])+    it "lowers ordering, provisioning, and raw group-key projection" $ do+      spec <- specOf "test/fixtures/reservation-work.keiro"+      case [workqueue | NWorkqueue workqueue <- (.nodes) spec] of+        workqueue : _ -> do+          let modules = scaffoldWorkqueue (defaultContext (spec.context)) workqueue+              queue = generatedTextEndingIn "Queue.hs" modules+              policy = generatedTextEndingIn "QueuePolicy.hs" modules+          queue `shouldSatisfy` T.isInfixOf "groupKeyFor payload = payload.reservationId"+          policy `shouldSatisfy` T.isInfixOf "jobOrdering = FifoThroughput"+          policy `shouldSatisfy` T.isInfixOf "withFifoIndexProvision (standardProvision)"+          policy `shouldSatisfy` T.isInfixOf "data ReservationWorkOutcome"+          policy `shouldSatisfy` T.isInfixOf "jobOutcomeFor :: ReservationWorkOutcome -> JobOutcome"+          policy `shouldNotSatisfy` T.isInfixOf "jobOutcomeFor :: Text -> JobOutcome"+          policy `shouldNotSatisfy` T.isInfixOf "  _ -> Retry"+          firewallBreaches modules `shouldBe` []+        [] -> expectationFailure "reservation-work fixture has no workqueue"++  describe "readmodel (EP-107)" $ do+    it "parses and round-trips first-class read models" $ do+      spec <- specOf "test/fixtures/readmodel.keiro"+      case [readModel | NReadModel readModel <- (.nodes) spec] of+        [subscriptionModel, inlineModel] -> do+          (.name) subscriptionModel `shouldBe` "transfer_decisions"+          (.columns) subscriptionModel+            `shouldBe` [ RmColumn "reservation_id" "text" True,+                         RmColumn "hospital_id" "text" True,+                         RmColumn "status" "text" True,+                         RmColumn "decided_at" "timestamptz" False+                       ]+          legacyReadModelScope subscriptionModel `shouldBe` Just (RmCategory "reservation")+          legacyReadModelFeed subscriptionModel `shouldBe` Just RmSubscription+          legacyReadModelSubscription subscriptionModel `shouldBe` Just "hospital-capacity-transfer-decisions-sub"+          (.name) inlineModel `shouldBe` "subscriptions"+          legacyReadModelScope inlineModel `shouldBe` Nothing+          legacyReadModelFeed inlineModel `shouldBe` Just RmInline+        nodes -> expectationFailure ("expected two readmodel nodes, got " <> show (length nodes))+      parseLanguage4RenderedSpec "in" spec `shouldBe` Right spec+    it "accepts an aggregate projection without a consistency clause" $ do+      spec <- parseInlineSpec "<projection-without-consistency>" projectionWithoutConsistencySpec+      case [projection | NAggregate aggregate <- (.nodes) spec, Just projection <- [(.projection) aggregate]] of+        [projection] -> (.consistency) projection `shouldBe` Nothing+        projections -> expectationFailure ("expected one projection, got " <> show (length projections))+    it "pins the canonical UTF-8 shape digest and runtime identities" $ do+      spec <- specOf "test/fixtures/readmodel.keiro"+      case [readModel | NReadModel readModel <- (.nodes) spec] of+        (subscriptionModel : inlineModel : _) -> do+          canonicalShape subscriptionModel+            `shouldBe` "transfer_decisions|reservation_id:text:req|hospital_id:text:req|status:text:req|decided_at:timestamptz:null"+          deriveShapeHash subscriptionModel `shouldBe` "fnv1a:3717f6d9e3c44bd6"+          deriveShapeHash inlineModel `shouldBe` "fnv1a:f54d9bb2f40a6738"+          registryNameFor (spec.context) subscriptionModel `shouldBe` "hospital-capacity-transfer-decisions"+          subscriptionNameFor (spec.context) subscriptionModel `shouldBe` "hospital-capacity-transfer-decisions-sub"+          subscriptionNameFor "billing" inlineModel `shouldBe` "billing-subscriptions-sub"+        nodes -> expectationFailure ("expected readmodel nodes, got " <> show (length nodes))+    it "accepts the positive readmodel fixture with all references resolved" $ do+      spec <- specOf "test/fixtures/readmodel.keiro"+      validateSpec spec `shouldBe` []+    it "rejects shape drift and unknown SQL column types" $ do+      codes <- errorCodesOf "test/fixtures/readmodel-shape-drift.keiro"+      codes `shouldContain` [RmShapeHashDrift, RmUnknownColumnType]+    it "rejects Strong on inline and standalone projections" $ do+      inlineCodes <- errorCodesOf "test/fixtures/readmodel-strong-inline.keiro"+      inlineCodes `shouldContain` [RmStrongInlineOnly]+      standalone <- specOf "test/fixtures/readmodel-strong-standalone.keiro"+      let diagnostics = validateSpec standalone+      map (.code) diagnostics `shouldContain` [RmStrongInlineOnly, RmProjectionWithoutNode]+      [(.severity) diagnostic | diagnostic <- diagnostics, (.code) diagnostic == RmProjectionWithoutNode]+        `shouldBe` [Warning]+    it "rejects scope without Strong and an unreferenced inline feed" $ do+      scopeCodes <- errorCodesOf "test/fixtures/readmodel-scope-eventual.keiro"+      scopeCodes `shouldContain` [RmScopeWithoutStrong]+      inlineCodes <- errorCodesOf "test/fixtures/readmodel-inline-unreferenced.keiro"+      inlineCodes `shouldContain` [RmInlineFeedUnreferenced]+    it "warns when an inline feed carries an ignored subscription override" $ do+      source <- readTestText "test/fixtures/readmodel.keiro"+      spec <-+        parseInlineSpec+          "<inline-subscription>"+          (T.replace "  feed = inline\n" "  feed = inline\n  subscription = \"ignored-subscription\"\n" source)+      diagnosticCodes spec `shouldContain` [RmInlineSubscriptionIgnored]+    it "rejects projection consistency conflicts" $ do+      codes <- errorCodesOf "test/fixtures/readmodel-consistency-conflict.keiro"+      codes `shouldContain` [RmConsistencyConflict]+    it "resolves query read models and validates query consistency" $ do+      codes <- errorCodesOf "test/fixtures/readmodel-query-unresolved.keiro"+      codes `shouldContain` [QueryUnresolvedReadModel, QueryConsistencyInvalid]+    it "resolves dispatch read models and declared dedup columns" $ do+      codes <- errorCodesOf "test/fixtures/readmodel-dispatch-unresolved.keiro"+      codes `shouldContain` [DispatchReadModelUnresolved, DispatchReadModelFieldUnknown]+    it "scaffolds runtime records, rebuild helpers, async wiring, and typed holes" $ do+      spec <- specOf "test/fixtures/readmodel.keiro"+      let ctx = defaultContext (spec.context)+          readModels = [readModel | NReadModel readModel <- (.nodes) spec]+          modules = concatMap (scaffoldReadModel ctx) readModels+          transfer = generatedTextEndingIn "TransferDecisions/ReadModel.hs" modules+          inline = generatedTextEndingIn "Subscriptions/ReadModel.hs" modules+          transferHoles = [(.text) m | m <- modules, "TransferDecisions/ReadModelHoles.hs" `T.isSuffixOf` T.pack ((.path) m)]+      length modules `shouldBe` 6+      length [m | m <- modules, (.kind) m == Generated] `shouldBe` 4+      length [m | m <- modules, (.kind) m == HoleStub] `shouldBe` 2+      firewallBreaches modules `shouldBe` []+      transfer `shouldSatisfy` T.isInfixOf "registerTransferDecisions"+      transfer `shouldSatisfy` T.isInfixOf "Rebuild.startRebuild transferDecisionsReadModel [\"hospital-capacity-transfer-decisions-async\"]"+      transfer `shouldSatisfy` T.isInfixOf "strongScope = CategoryHead \"reservation\""+      transfer `shouldSatisfy` T.isInfixOf "transferDecisionsAsyncProjection"+      inline `shouldSatisfy` T.isInfixOf "Rebuild.startRebuild subscriptionsReadModel []"+      inline `shouldNotSatisfy` T.isInfixOf "AsyncProjection"+      transferHoles `shouldSatisfy` any (T.isInfixOf "RecordedEvent -> Tx.Transaction ()")+    it "threads qualified table and column guidance into aggregate projection holes" $ do+      spec <- specOf "test/fixtures/readmodel.keiro"+      case [aggregate | NAggregate aggregate <- (.nodes) spec] of+        [aggregate] -> do+          let modules = scaffoldAggregate (defaultContext (spec.context)) spec aggregate+              holes = [(.text) m | m <- modules, (.kind) m == HoleStub]+              projection = generatedTextEndingIn "Projection.hs" modules+          holes `shouldSatisfy` any (T.isInfixOf "subscriptionsQualifiedTable")+          holes `shouldSatisfy` any (T.isInfixOf "Table: \"billing\".\"subscriptions\"")+          projection `shouldSatisfy` T.isInfixOf "ReadModelTable.subscriptionsQualifiedTable"+        aggregates -> expectationFailure ("expected one aggregate, got " <> show (length aggregates))+    it "emits runtime-free derivation facts for each read model" $ do+      spec <- specOf "test/fixtures/readmodel.keiro"+      case [readModel | NReadModel readModel <- (.nodes) spec] of+        (subscriptionModel : _) -> do+          let modules = harnessReadModel (defaultContext (spec.context)) spec subscriptionModel+              harnessText = generatedTextEndingIn "ReadModelHarness.hs" modules+          length modules `shouldBe` 1+          firewallBreaches modules `shouldBe` []+          harnessText `shouldNotSatisfy` T.isInfixOf "{-# LANGUAGE OverloadedRecordDot #-}"+          harnessText `shouldSatisfy` T.isInfixOf "import Generated.HospitalCapacity.TransferDecisions.ReadModel (transferDecisionsReadModel, transferDecisionsAsyncProjection)"+          harnessText `shouldSatisfy` T.isInfixOf "(\"shapeHash\", \"fnv1a:3717f6d9e3c44bd6\", T.unpack transferDecisionsReadModel.shapeHash)"+          harnessText `shouldSatisfy` T.isInfixOf "(\"strongScope\", \"CategoryHead reservation\", renderStrongScope transferDecisionsReadModel.strongScope)"+          harnessText `shouldSatisfy` T.isInfixOf "T.unpack transferDecisionsAsyncProjection.name"+          harnessText `shouldSatisfy` T.isInfixOf "runReadModelFacts"+        nodes -> expectationFailure ("expected readmodel nodes, got " <> show (length nodes))++  describe "workflow/operation (EP-6)" $ do+    it "round-trips the workflow spec through parse . pretty" $ do+      input <- readTestText "test/fixtures/workflow.keiro"+      case parseSpec "in" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> parseLanguage4RenderedSpec "in" spec `shouldBe` Right spec+    it "accepts the workflow spec (await<->signal matches, run resolves)" $ do+      codes <- errorCodesOf "test/fixtures/workflow.keiro"+      codes `shouldBe` []+    it "rejects a signal label with no matching await as AwaitSignalMismatch" $ do+      codes <- errorCodesOf "test/fixtures/workflow-signal-mismatch.keiro"+      codes `shouldContain` [AwaitSignalMismatch]+    it "rejects duplicate workflow labels" $ do+      codes <- errorCodesOf "test/fixtures/workflow-dup-label.keiro"+      codes `shouldContain` [WorkflowDuplicateLabel]+    it "rejects unresolved workflow id and sleep fields" $ do+      codes <- errorCodesOf "test/fixtures/workflow-unresolved-fields.keiro"+      codes `shouldContain` [WorkflowIdFieldUnresolved, WorkflowSleepDelayUnresolved]+    it "validates rule domains, totality, case constructors, and bodies" $ do+      unresolved <- errorCodesOf "test/fixtures/rule-bad-domain.keiro"+      unresolved `shouldBe` [RuleDomainUnresolved]+      codes <- errorCodesOf "test/fixtures/rule-not-total.keiro"+      mapM_+        (\expected -> codes `shouldContain` [expected])+        [RuleNotTotal, RuleCaseUnknownCtor, ClockSampled, GuardAtomOutOfScope]+    it "rejects unresolved command operation references" $ do+      codes <- errorCodesOf "test/fixtures/operation-ghost-aggregate.keiro"+      codes `shouldContain` [OperationUnresolvedRef]+    it "rejects a signal value type that differs from its await" $ do+      codes <- errorCodesOf "test/fixtures/operation-signal-value.keiro"+      codes `shouldContain` [AwaitSignalValueMismatch]+    it "round-trips guarded patches and terminal continueAsNew" $ do+      input <- readTestText "test/fixtures/workflow-evolution.keiro"+      case parseSpec "workflow-evolution" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> do+          parseSpec "workflow-evolution" (renderSpec spec) `shouldBe` Right spec+          errorCodes spec `shouldBe` []+    it "rejects duplicate patch ids anywhere in the workflow body" $ do+      codes <- errorCodesOf "test/fixtures/workflow-patch-dup.keiro"+      codes `shouldBe` [WorkflowPatchDuplicate]+    it "rejects non-terminal and nested continueAsNew" $ do+      codes <- errorCodesOf "test/fixtures/workflow-can-mid.keiro"+      codes `shouldBe` [WorkflowContinueAsNewNotTerminal, WorkflowContinueAsNewNotTerminal]+    it "rejects a colon in a patch id with a workflow diagnostic" $ do+      codes <- errorCodesOf "test/fixtures/workflow-patch-colon.keiro"+      codes `shouldBe` [WorkflowPatchIdInvalid]+    it "lowers patch facts and live runtime declarations" $ do+      spec <- specOf "test/fixtures/workflow-evolution.keiro"+      case [workflow | NWorkflow workflow <- (.nodes) spec] of+        [workflow] -> do+          let modules = harnessWorkflow (defaultContext (spec.context)) workflow+              facts = generatedTextEndingIn "WorkflowFacts.hs" modules+              runtime = generatedTextEndingIn "WorkflowRuntime.hs" modules+          facts `shouldSatisfy` T.isInfixOf "patch:fraud-check-v2(step:fraud-check)"+          facts `shouldSatisfy` T.isInfixOf "continueAsNew:RolloverSeed"+          facts `shouldSatisfy` T.isInfixOf "data WorkflowFacts = WorkflowFacts"+          facts `shouldSatisfy` T.isInfixOf "workflowFactBody = [\"step:create-transfer-hold\", \"patch:fraud-check-v2(step:fraud-check)\""+          facts `shouldSatisfy` T.isInfixOf "workflowFactAwaitLabels = [\"reservation-confirmation\"]"+          facts `shouldSatisfy` T.isInfixOf "workflowFactPatchIds = [\"fraud-check-v2\"]"+          runtime `shouldSatisfy` T.isInfixOf "data AwaitBinding = AwaitBinding StepName"+          runtime `shouldSatisfy` T.isInfixOf "reservationConfirmationAwait :: AwaitBinding"+          runtime `shouldSatisfy` T.isInfixOf "reservationConfirmationAwait = AwaitBinding (StepName \"reservation-confirmation\")"+          runtime `shouldSatisfy` T.isInfixOf "allocateDeclaredAwait (AwaitBinding label) = awakeableNamed label"+          runtime `shouldSatisfy` (not . T.isInfixOf "awaitAwakeableId")+          runtime `shouldSatisfy` (not . T.isInfixOf "generation0AwakeableId")+          runtime `shouldSatisfy` (not . T.isInfixOf "Awakeable.Compatibility")+          runtime `shouldSatisfy` T.isInfixOf "declaredPatches = Set.fromList [PatchId \"fraud-check-v2\"]"+          runtime `shouldSatisfy` T.isInfixOf "opts{activePatches = declaredPatches}"+        workflows -> expectationFailure ("expected one workflow, got " <> show (length workflows))+    it "rejects colliding await binding names, including an await nested under a patch" $ do+      spec <-+        parseInlineSpec "<workflow-await-binding-collision>" $+          T.unlines+            [ "language keiro-dsl 4",+              "context await-binding-collision",+              "workflow CollisionWorkflow",+              "  name \"collision-workflow\"",+              "  in Input",+              "  out Output",+              "  id from input via idText",+              "  body",+              "    patch nested-proof {",+              "      await foo-bar -> Text",+              "    }",+              "    await foo_bar -> Text"+            ]+      let collisions = [diagnostic | diagnostic <- validateSpec spec, (.code) diagnostic == GeneratedOccurrenceCollision]+      length collisions `shouldBe` 1+      map (.message) collisions `shouldSatisfy` any (T.isInfixOf "fooBarAwait")+      collisions `shouldSatisfy` all (not . null . (.relatedLocations))++  describe "transition family" $ do+    it "cancels identical Language-5 siblings across source locations, additions, and declaration order" $ do+      source <- readTestText "test/fixtures/transition-family.keiro"+      base <- parsedSourceOf "test/fixtures/transition-family.keiro"+      additive <- parsedSourceOf "test/fixtures/transition-family-additive.keiro"+      relocated <-+        case parseSource "<transition-family-relocated>" (T.replace "\n  Active -- ObserveDescription -->" "\n\n\n  Active -- ObserveDescription -->" source) of+          Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+          Right parsed -> pure parsed+      let guardCodes parsedOld parsedNew =+            [ (.code) (kindOfChange change)+            | change <- diffSources parsedOld parsedNew,+              (.code) (kindOfChange change) `elem` [AggGuardTightened, AggGuardRelationUnknown]+            ]+      guardCodes base base `shouldBe` []+      guardCodes base relocated `shouldBe` []+      guardCodes base additive `shouldBe` []+      ReplayImpact.replayImpactServices (checkedSource base) (checkedSource base)+        `shouldBe` Right ReplayNeutral+      ReplayImpact.replayImpactServices (checkedSource base) (checkedSource relocated)+        `shouldBe` Right ReplayNeutral++      let baseSpec = checkedSpec (checkedSource base)+          aggregate = onlyAggregate baseSpec+          withTransitions transitions =+            modifyAggregate+              ((.name) aggregate)+              (\candidate -> candidate {transitions})+              baseSpec+      forM_ (permutations aggregate.transitions) $ \oldOrder ->+        forM_ (permutations aggregate.transitions) $ \newOrder -> do+          let oldSpec = withTransitions oldOrder+              newSpec = withTransitions newOrder+              changes = diffSpecs oldSpec newSpec+          [changeCode change | change <- changes, changeCode change `elem` [AggGuardTightened, AggGuardRelationUnknown]]+            `shouldBe` []+          replayImpactSpecs oldSpec newSpec `shouldBe` ReplayNeutral++    it "preserves duplicate counts and empty-side replay semantics" $ do+      base <- specOf "test/fixtures/transition-family.keiro"+      let aggregate = onlyAggregate base+          withTransitions transitions =+            modifyAggregate+              ((.name) aggregate)+              (\candidate -> candidate {transitions})+              base+      case [transition | transition <- aggregate.transitions, not (null transition.emits)] of+        emitting : _ -> do+          let duplicate = withTransitions [emitting, emitting]+              single = withTransitions [emitting]+              empty = withTransitions []+          replayImpactSpecs duplicate duplicate `shouldBe` ReplayNeutral+          replayImpactSpecs empty single `shouldBe` ReplayNeutral+          replayImpactSpecs duplicate single `shouldBe` ReplayNeutral+          replayImpactSpecs single empty `shouldSatisfy` (/= ReplayNeutral)+          forM_ [(duplicate, duplicate), (empty, single), (duplicate, single), (single, empty)] $ \(oldSpec, newSpec) ->+            [changeCode change | change <- diffSpecs oldSpec newSpec, changeCode change == AggGuardRelationUnknown]+              `shouldBe` []+        [] -> expectationFailure "transition-family fixture must contain an emitting transition"++    it "excludes no-emit guard edits from guard-history classification" $ do+      changes <- diffFixtures "test/fixtures/transition-family.keiro" "test/fixtures/transition-family-no-emit-tightened.keiro"+      [changeCode change | change <- changes, changeCode change `elem` [AggGuardTightened, AggGuardRelationUnknown]]+        `shouldBe` []++    it "reports ambiguous emitting remainders without inventing a twin" $ do+      changes <- diffFixtures "test/fixtures/transition-family-ambiguous-old.keiro" "test/fixtures/transition-family-ambiguous-new.keiro"+      let findings =+            [ kind+            | Advisory kind <- changes,+              (.code) kind == AggGuardRelationUnknown+            ]+      finding <- case findings of+        [value] -> pure value+        values -> expectationFailure ("expected one ambiguous-family finding, got " <> show (length values)) >> fail "unreachable"+      (.subject) finding `shouldBe` "Active -- ObserveDescription"+      (.detail) finding `shouldSatisfy` T.isInfixOf "2 old and 2 new transitions"+      (.detail) finding `shouldSatisfy` T.isInfixOf "Hole behavior cannot be copied"+      (.detail) finding `shouldNotSatisfy` T.isInfixOf "\n\nreplay-only "+      verdictFor PrivateHistoryRead (finding.vector) `shouldBe` VAdvisory+      remediationFor (finding.context) ((.code) finding)+        `shouldBe` RemedyDoNotDeploy "do not deploy until the transition-family ambiguity is resolved or a targeted replay audit proves the affected history safe" :| []+      let reportJson =+            LazyText.toStrict+              ( LazyTextEncoding.decodeUtf8+                  (Aeson.encode (diffReport defaultGate [Advisory finding]))+              )+      reportJson `shouldSatisfy` T.isInfixOf "AggGuardRelationUnknown"+      reportJson `shouldSatisfy` T.isInfixOf "do not deploy until the transition-family ambiguity is resolved"+      reportJson `shouldNotSatisfy` T.isInfixOf "run the generated conformance"++    it "prints a valid Language-5 twin without a forward outcome" $ do+      old <- parsedSourceOf "test/fixtures/transition-family-outcome-old.keiro"+      new <- parsedSourceOf "test/fixtures/transition-family-outcome-new.keiro"+      newSource <- readTestText "test/fixtures/transition-family-outcome-new.keiro"+      let findings =+            [ kind+            | Advisory kind <- diffSources old new,+              (.code) kind == AggGuardTightened+            ]+      finding <- case findings of+        [value] -> pure value+        values -> expectationFailure ("expected one guard-tightening finding, got " <> show (length values)) >> fail "unreachable"+      let twinText = snd (T.breakOnEnd "\n\n" ((.detail) finding))+          pastedSource = newSource <> "\n" <> twinText <> "\n"+      twinText `shouldSatisfy` T.isPrefixOf "replay-only "+      twinText `shouldNotSatisfy` T.isInfixOf "outcome"+      pasted <- case parseSource "<transition-family-outcome-pasted>" pastedSource of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right parsed -> pure parsed+      [(.code) diagnostic | diagnostic <- validateService (checkedSource pasted), (.severity) diagnostic == Error]+        `shouldBe` []+      [kind | Advisory kind <- diffSources old pasted, (.code) kind == AggGuardTightened]+        `shouldBe` []++      let oldSpec = checkedSpec (checkedSource old)+          outcomeOnly =+            modifyAggregate+              "ProjectArtifact"+              ( \aggregate ->+                  aggregate+                    { transitions =+                        [ transition {outcome = Nothing, outcomeDuplicateLocs = []}+                        | transition <- aggregate.transitions+                        ]+                    }+              )+              oldSpec+      [changeCode change | change <- diffSpecs oldSpec outcomeOnly, changeCode change `elem` [AggGuardTightened, AggGuardRelationUnknown]]+        `shouldBe` []++    it "keeps printed twins pasteable under every released language" $ do+      forM_ [1 :: Int .. 4] $ \selectedVersion -> do+        let version = T.pack (show selectedVersion)+            fixtureSource guardExpression =+              T.unlines+                [ "language keiro-dsl " <> version,+                  "context transition-family-language",+                  "",+                  "aggregate Example",+                  "  regs",+                  "    marker Text = \"\"",+                  "  states Open Closed!",+                  "",+                  "  command Close { accepted:Bool extra:Bool }",+                  "  event ClosedEvent = fields(Close)",+                  "",+                  "  Open -- Close -->",+                  "    guard " <> guardExpression,+                  "    emit ClosedEvent",+                  "    goto Closed"+                ]+            oldSource = fixtureSource "accepted"+            newSource = fixtureSource "accepted && extra"+            parseChecked name input = case parseSource name input of+              Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+              Right parsed -> pure parsed+        old <- parseChecked ("<transition-family-language-" <> show selectedVersion <> "-old>") oldSource+        new <- parseChecked ("<transition-family-language-" <> show selectedVersion <> "-new>") newSource+        let findings =+              [ kind+              | Advisory kind <- diffSources old new,+                (.code) kind == AggGuardTightened+              ]+        finding <- case findings of+          [value] -> pure value+          values -> expectationFailure ("expected one language-" <> show selectedVersion <> " tightening, got " <> show (length values)) >> fail "unreachable"+        let twinText = snd (T.breakOnEnd "\n\n" ((.detail) finding))+            pastedSource = newSource <> "\n" <> twinText <> "\n"+        twinText `shouldNotSatisfy` T.isInfixOf "outcome"+        pasted <- parseChecked ("<transition-family-language-" <> show selectedVersion <> "-pasted>") pastedSource+        [(.code) diagnostic | diagnostic <- validateService (checkedSource pasted), (.severity) diagnostic == Error]+          `shouldBe` []+        [kind | Advisory kind <- diffSources old pasted, (.code) kind == AggGuardTightened]+          `shouldBe` []++  describe "replay body" $ do+    it "compares complete guard unions after exact cancellation" $ do+      base <- specOf "test/fixtures/transition-family.keiro"+      let aggregate = onlyAggregate base+          emitting =+            case [transition | transition <- aggregate.transitions, transition.emits == ["DescriptionObserved"]] of+              [transition] -> transition+              transitions -> error ("expected one DescriptionObserved transition, got " <> show (length transitions))+          a =+            case emitting.guard of+              Just expression -> expression+              Nothing -> error "DescriptionObserved transition must be guarded"+          b = complementExpr a+          aOrB = EOr a b+          edge guardExpression = emitting {guard = guardExpression, outcome = Nothing, outcomeDuplicateLocs = [], loc = noLoc}+          withTransitions transitions =+            modifyAggregate aggregate.name (\candidate -> candidate {transitions}) base+          unchangedUnionOld = withTransitions [edge (Just aOrB), edge (Just a)]+          unchangedUnionNew = withTransitions [edge (Just aOrB)]+          split = withTransitions [edge (Just a), edge (Just b)]+          explicitTrue = withTransitions [edge (Just (ELiteral noLoc (LiteralBool True)))]+          unguarded = withTransitions [edge Nothing]+          explicitFalse = withTransitions [edge (Just (ELiteral noLoc (LiteralBool False)))]+          narrowed = withTransitions [edge (Just a)]+      replayImpactSpecs unchangedUnionOld unchangedUnionNew `shouldBe` ReplayNeutral+      replayImpactSpecs (withTransitions [edge (Just aOrB)]) split `shouldBe` ReplayNeutral+      replayImpactSpecs split (withTransitions [edge (Just aOrB)]) `shouldBe` ReplayNeutral+      replayImpactSpecs explicitTrue unguarded `shouldBe` ReplayNeutral+      replayImpactSpecs explicitFalse narrowed `shouldBe` ReplayNeutral+      replayImpactSpecs (withTransitions [edge (Just aOrB)]) narrowed `shouldSatisfy` (/= ReplayNeutral)+      let guardCodes oldSpec newSpec =+            [ changeCode change+            | change <- diffSpecs oldSpec newSpec,+              changeCode change `elem` [AggGuardTightened, AggGuardRelationUnknown, AggGuardRemedyUnavailable]+            ]+      guardCodes unchangedUnionOld unchangedUnionNew `shouldBe` []+      guardCodes (withTransitions [edge (Just aOrB)]) split `shouldBe` []+      guardCodes split (withTransitions [edge (Just aOrB)]) `shouldBe` []+      guardCodes explicitTrue unguarded `shouldBe` []+      guardCodes explicitFalse narrowed `shouldBe` []++    it "targets both sides of a replay-body replacement" $ do+      base <- specOf "test/fixtures/transition-family.keiro"+      let aggregate = onlyAggregate base+          emitting =+            case [transition | transition <- aggregate.transitions, transition.emits == ["DescriptionObserved"]] of+              [transition] -> transition+              transitions -> error ("expected one DescriptionObserved transition, got " <> show (length transitions))+          descriptionEvent =+            case [event | event <- aggregate.events, event.name == "DescriptionObserved"] of+              [event] -> event+              events -> error ("expected one DescriptionObserved event, got " <> show (length events))+          replacementEvent = eventWithNameAndLoc "DescriptionObservedAgain" noLoc descriptionEvent+          baseWithReplacementEvent =+            modifyAggregate aggregate.name (\candidate -> candidate {events = candidate.events <> [replacementEvent]}) base+          withTransition transition =+            modifyAggregate aggregate.name (\candidate -> candidate {transitions = [transition]}) baseWithReplacementEvent+          replacement = emitting {emits = ["DescriptionObservedAgain"], loc = noLoc}+      replayImpactSpecs (withTransition emitting) (withTransition replacement)+        `shouldBe` ReplayAffected+          ( Map.singleton+              aggregate.name+              AggregateImpact+                { eventTypes = Set.fromList ["DescriptionObserved", "DescriptionObservedAgain"],+                  includeSnapshotStreams = True+                }+          )++    it "classifies whole unions and requires complete replay-only coverage" $ do+      base <- specOf "test/fixtures/transition-family.keiro"+      let aggregate = onlyAggregate base+          emitting =+            case [transition | transition <- aggregate.transitions, transition.emits == ["DescriptionObserved"]] of+              [transition] -> transition+              transitions -> error ("expected one DescriptionObserved transition, got " <> show (length transitions))+          untouched =+            [ transition+            | transition <- aggregate.transitions,+              not (transition.source == emitting.source && transition.command == emitting.command && not (null transition.emits))+            ]+          a =+            case emitting.guard of+              Just expression -> expression+              Nothing -> error "DescriptionObserved transition must be guarded"+          b = complementExpr a+          aOrB = EOr a b+          edge guardExpression = emitting {guard = Just guardExpression, outcome = Nothing, outcomeDuplicateLocs = [], loc = noLoc}+          replayEdge guardExpression =+            ((edge guardExpression) :: Transition)+              { mode = TmReplayOnly,+                loc = noLoc+              }+          withFamily transitions =+            modifyAggregate aggregate.name (\candidate -> candidate {transitions = untouched <> transitions}) base+          guardFindings oldSpec newSpec =+            [ kind+            | Advisory kind <- diffSpecs oldSpec newSpec,+              kind.code `elem` [AggGuardTightened, AggGuardRelationUnknown, AggGuardRemedyUnavailable]+            ]+          oldUnion = withFamily [edge aOrB]+          splitUnion = withFamily [edge a, edge b]+          narrowed = withFamily [edge a]+          exactRemovedRegion = EAnd aOrB (complementExpr a)+          hazardCodes oldSpec newSpec = map (.code) (guardFindings oldSpec newSpec)+      guardFindings oldUnion splitUnion `shouldBe` []+      guardFindings splitUnion oldUnion `shouldBe` []+      case guardFindings oldUnion narrowed of+        [finding] -> do+          finding.code `shouldBe` AggGuardTightened+          finding.detail `shouldSatisfy` T.isInfixOf (renderTransition (replayEdge exactRemovedRegion))+        findings -> expectationFailure ("expected one whole-union finding, got " <> show findings)+      map (.code) (guardFindings oldUnion (withFamily [edge a, replayEdge b]))+        `shouldBe` []+      map (.code) (guardFindings oldUnion (withFamily [edge a, replayEdge (EAnd a b)]))+        `shouldBe` [AggGuardTightened]+      guardFindings oldUnion (withFamily [edge a, replayEdge exactRemovedRegion]) `shouldBe` []+      guardFindings oldUnion (withFamily [edge a, replayEdge aOrB]) `shouldBe` []+      case guardFindings oldUnion (withFamily []) of+        [finding] -> do+          finding.code `shouldBe` AggGuardTightened+          finding.detail `shouldSatisfy` T.isInfixOf (renderTransition (replayEdge aOrB))+        findings -> expectationFailure ("expected one removed-body finding, got " <> show findings)+      guardFindings oldUnion (withFamily [replayEdge aOrB]) `shouldBe` []++      let mismatchedCoverage =+            [ ("writes", transitionWithWrites [] (replayEdge exactRemovedRegion)),+              ("target", transitionWithGoto "Unregistered" (replayEdge exactRemovedRegion)),+              ("source", transitionWithSource "Unregistered" (replayEdge exactRemovedRegion)),+              ("owner", transitionWithImplementation HoleImplementation (replayEdge exactRemovedRegion))+            ]+      forM_ mismatchedCoverage $ \(dimension, wrongTwin) ->+        unless (not (null (hazardCodes oldUnion (withFamily [edge a, wrongTwin])))) $+          expectationFailure ("mismatched " <> dimension <> " replay twin suppressed the hazard")++    it "withholds a replay-only remedy that cannot validate in the candidate" $ do+      base <- specOf "test/fixtures/transition-family.keiro"+      let aggregate = onlyAggregate base+          emitting =+            case [transition | transition <- aggregate.transitions, transition.emits == ["DescriptionObserved"]] of+              [transition] -> transition+              transitions -> error ("expected one DescriptionObserved transition, got " <> show (length transitions))+          candidate =+            modifyAggregate+              aggregate.name+              ( \value ->+                  value+                    { events = filter ((/= "DescriptionObserved") . (.name)) value.events,+                      transitions =+                        [ transition+                        | transition <- value.transitions,+                          not (transition.source == emitting.source && transition.command == emitting.command && not (null transition.emits))+                        ]+                    }+              )+              base+          findings =+            [ kind+            | Advisory kind <- diffSpecs base candidate,+              kind.code `elem` [AggGuardTightened, AggGuardRemedyUnavailable]+            ]+      case findings of+        [finding] -> do+          finding.code `shouldBe` AggGuardRemedyUnavailable+          finding.detail `shouldSatisfy` T.isInfixOf "source validation failed"+          finding.detail `shouldNotSatisfy` T.isInfixOf "\n\nreplay-only "+          remediationFor finding.context finding.code+            `shouldBe` RemedyDoNotDeploy "do not deploy until the replay-only remedy validates under the candidate language or a targeted replay audit proves the affected history safe" :| []+        values -> expectationFailure ("expected one unavailable-remedy finding, got " <> show values)++    it "round-trips an affected aggregate without flattening a composed graph into one source" $ do+      base <- specOf "test/fixtures/projection-catalog.keiro"+      let aggregateNodes = [node | node@(NAggregate _) <- base.nodes]+          otherNodes = [node | node <- base.nodes, case node of NAggregate _ -> False; _ -> True]+          composedOrder = specWithNodes (aggregateNodes <> otherNodes) base+          falseGuard = Just (ELiteral noLoc (LiteralBool False))+          tightened =+            modifyAggregate+              "Orders"+              (\aggregate -> aggregateWithTransitions (map (transitionWithGuard falseGuard) aggregate.transitions) aggregate)+              composedOrder+          findings =+            [ kind+            | Advisory kind <- diffSpecs composedOrder tightened,+              kind.code `elem` [AggGuardTightened, AggGuardRemedyUnavailable]+            ]+      map (.code) findings `shouldBe` [AggGuardTightened]+      map (.detail) findings `shouldSatisfy` all (not . T.isInfixOf "render/parse failed")++    it "validates every proposed remedy alone and with its aggregate peers" $ do+      base <- specOf "test/fixtures/transition-family.keiro"+      let aggregate = onlyAggregate base+          falseGuard = Just (ELiteral noLoc (LiteralBool False))+          tightenEmitting transition+            | null transition.emits = transition+            | otherwise = transitionWithGuard falseGuard transition+          candidate =+            modifyAggregate+              aggregate.name+              (\value -> aggregateWithTransitions (map tightenEmitting value.transitions) value)+              base+          findings =+            [ kind+            | Advisory kind <- diffSpecs base candidate,+              kind.code `elem` [AggGuardTightened, AggGuardRemedyUnavailable]+            ]+      map (.code) findings `shouldBe` [AggGuardTightened, AggGuardTightened]++  describe "replay impact" $ do+    it "treats new events and transitions as replay-neutral" $ do+      old <- specOf "test/fixtures/reservation.keiro"+      let aggregate = onlyAggregate old+      case ((.events) aggregate, (.transitions) aggregate) of+        (event : _, transition : _) -> do+          let newEvent = eventWithNameAndLoc "ReservationReviewed" noLoc event+              newTransition =+                transition+                  { emits = ["ReservationReviewed"],+                    loc = noLoc+                  }+              new =+                modifyAggregate+                  "Reservation"+                  ( \candidate ->+                      candidate+                        { events = (.events) candidate <> [newEvent],+                          transitions = (.transitions) candidate <> [newTransition]+                        }+                  )+                  old+          replayImpactSpecs old new `shouldBe` ReplayNeutral+        _ -> expectationFailure "reservation fixture must contain an event and transition"++    it "narrows a guard edit to that transition's event types" $ do+      impact <- replayImpactFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-guard-tightened.keiro"+      impact+        `shouldBe` ReplayAffected+          ( Map.singleton+              "Reservation"+              AggregateImpact+                { eventTypes = Set.singleton "TransferReservationCreated",+                  includeSnapshotStreams = True+                }+          )++    it "proves a syntactic guard loosening replay-neutral" $ do+      old <- specOf "test/fixtures/reservation.keiro"+      let loosened =+            modifyAggregate+              "Reservation"+              ( \aggregate ->+                  aggregate+                    { transitions =+                        [ transition {guard = Nothing}+                        | transition <- (.transitions) aggregate+                        ]+                    }+              )+              old+      replayImpactSpecs old loosened `shouldBe` ReplayNeutral++    it "pairs guard-disambiguated siblings independently of both declaration orders" $ do+      base <- specOf "test/fixtures/reservation.keiro"+      let aggregate = onlyAggregate base+      case ((.transitions) aggregate, (.events) aggregate) of+        (prototype : _, firstEvent : secondEvent : _) -> do+          let sibling guardExpression eventName =+                prototype+                  { guard = guardExpression,+                    emits = [eventName],+                    loc = noLoc+                  }+              commandOverride = EPath noLoc CommandRoot ["lifeCriticalOverride"]+              exact = sibling (Just (EAtom (ABool True))) ((.name) firstEvent)+              loosenedOld = sibling (Just commandOverride) ((.name) firstEvent)+              loosenedNew = sibling Nothing ((.name) firstEvent)+              changedOld = sibling (Just (ECmp OpEq commandOverride (ELiteral noLoc (LiteralBool False)))) ((.name) secondEvent)+              changedNew = sibling (Just (ECmp OpEq commandOverride (ELiteral noLoc (LiteralBool True)))) ((.name) firstEvent)+              oldSiblings = [exact, loosenedOld, changedOld]+              newSiblings = [exact, loosenedNew, changedNew]+              withTransitions transitions =+                modifyAggregate+                  ((.name) aggregate)+                  (\candidate -> candidate {transitions = transitions})+                  base+              impacts =+                [ replayImpactSpecs (withTransitions oldOrder) (withTransitions newOrder)+                | oldOrder <- permutations oldSiblings,+                  newOrder <- permutations newSiblings+                ]+          case impacts of+            firstImpact : remainingImpacts -> do+              remainingImpacts `shouldSatisfy` all (== firstImpact)+              firstImpact `shouldSatisfy` (/= ReplayNeutral)+            [] -> expectationFailure "permutations unexpectedly produced no replay comparisons"+        _ -> expectationFailure "reservation fixture must contain one transition and two events"++    it "marks every existing event when the aggregate wire convention changes" $ do+      impact <- replayImpactFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-wire.keiro"+      case impact of+        ReplayAffected aggregates ->+          (.eventTypes) <$> Map.lookup "Reservation" aggregates+            `shouldBe` Just (Set.fromList ["TransferReservationCreated", "TransferReservationConfirmed"])+        ReplayNeutral -> expectationFailure "expected a wire-clause replay impact"++    it "includes snapshot streams when a write expression changes" $ do+      impact <- replayImpactFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-foldchange.keiro"+      case impact of+        ReplayAffected aggregates ->+          (.includeSnapshotStreams) <$> Map.lookup "Reservation" aggregates+            `shouldBe` Just True+        ReplayNeutral -> expectationFailure "expected a fold replay impact"++    it "detects codec evolution and ignores formatting-only rewrites" $ do+      changed <- replayImpactFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-v2.keiro"+      changed `shouldSatisfy` (/= ReplayNeutral)+      old <- specOf "test/fixtures/reservation.keiro"+      formatted <- shouldParseStableRenderedSpec "<formatted>" old+      replayImpactSpecs old formatted `shouldBe` ReplayNeutral++    it "names mapped nested event and snapshot roots while ignoring Haskell-only changes" $ do+      nested <- replayImpactFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-nested-propagation.keiro"+      case nested of+        ReplayAffected aggregates ->+          Map.lookup "Catalog" aggregates+            `shouldBe` Just AggregateImpact {eventTypes = Set.singleton "ArtifactObserved", includeSnapshotStreams = True}+        ReplayNeutral -> expectationFailure "expected nested mapped wire change to affect replay"+      sourceOnly <- replayImpactFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-haskell-rename.keiro"+      sourceOnly `shouldBe` ReplayNeutral++    it "generates one context target for every aggregate, including the process saga" $ do+      spec <- specOf "test/fixtures/surge-service.keiro"+      case scaffoldReplayAudit (defaultContext (spec.context)) spec of+        [assembly] -> do+          (.path) assembly `shouldBe` "Generated/SurgeDemo/ReplayAudit.hs"+          (.text) assembly `shouldSatisfy` T.isInfixOf "Hospital.hospitalEventStream"+          (.text) assembly `shouldSatisfy` T.isInfixOf "Surge.surgeEventStream"+          T.count "      AuditTarget" ((.text) assembly) `shouldBe` 2+        assemblies -> expectationFailure ("expected one replay-audit assembly, got " <> show (length assemblies))++  describe "diff (evolution classification)" $ do+    it "covers every node family exactly once and explains exclusions" $ do+      sort (map fst familyRegistry) `shouldBe` ([minBound .. maxBound] :: [NodeFamily])+      [reason | (_, OutOfDiffScope reason) <- familyRegistry, T.null reason] `shouldBe` []+    it "reports checked mapped consumers separately from compatibility findings" $ do+      old <- specOf "test/fixtures/semantic-impact.keiro"+      let new = mapMappedStructural "NestedPayload" changeMappedCanonical old+          changes = diffSpecs old new+          impact = CheckedDiff.mappedSemanticImpact old new+          rendered = T.unlines (renderSemanticImpact impact)+          encoded = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReportWithSemanticImpact defaultGate changes impact)))+      map (.declaration) impact `shouldBe` [MappedKey "NestedPayload"]+      rendered `shouldSatisfy` T.isInfixOf "previous aggregate consumers: Alpha"+      rendered `shouldSatisfy` T.isInfixOf "current aggregate consumers:  Alpha"+      rendered `shouldSatisfy` T.isInfixOf "service-conformance: impacted"+      rendered `shouldSatisfy` (not . T.isInfixOf "Beta")+      encoded `shouldSatisfy` T.isInfixOf "\"semanticImpact\""+      encoded `shouldSatisfy` T.isInfixOf "\"previousConsumers\":[\"Alpha\"]"+      let reordered = old {mapped = reverse ((.mapped) old), nodes = reverse ((.nodes) old)}+      CheckedDiff.mappedSemanticImpact old reordered `shouldBe` []+    it "reports added, removed, and unused mapped declarations without inventing aggregate consumers" $ do+      let declarationA = completeStructural "A" (recordShape [TText])+          declarationB = completeStructural "B" (recordShape [TInt])+          onlyA = mappedSpec [declarationA]+          withB = mappedSpec [declarationA, declarationB]+          added = CheckedDiff.mappedSemanticImpact onlyA withB+          removed = CheckedDiff.mappedSemanticImpact withB onlyA+          expectedB = MappedKey "B"+      map (.declaration) added `shouldBe` [expectedB]+      map (.previousConsumers) added `shouldBe` [Set.empty]+      map (.currentConsumers) added `shouldBe` [Set.empty]+      map (.serviceConformance) added `shouldBe` [True]+      map (.declaration) removed `shouldBe` [expectedB]+      map (.previousConsumers) removed `shouldBe` [Set.empty]+      map (.currentConsumers) removed `shouldBe` [Set.empty]+      map (.serviceConformance) removed `shouldBe` [True]++      old <- specOf "test/fixtures/semantic-impact.keiro"+      let changed = mapMappedStructural "UnusedPayload" changeMappedCanonical old+          unusedImpact = CheckedDiff.mappedSemanticImpact old changed+      map (.declaration) unusedImpact `shouldBe` [MappedKey "UnusedPayload"]+      map (.previousConsumers) unusedImpact `shouldBe` [Set.empty]+      map (.currentConsumers) unusedImpact `shouldBe` [Set.empty]+      map (.serviceConformance) unusedImpact `shouldBe` [True]+    it "derives every exercised headline from its vector under the default gate" $ do+      changes <-+        concat+          <$> mapM+            (uncurry diffFixtures)+            [ ("test/fixtures/reservation.keiro", "test/fixtures/reservation-fieldadd.keiro"),+              ("test/fixtures/reservation.keiro", "test/fixtures/reservation-v2.keiro"),+              ("test/fixtures/reservation.keiro", "test/fixtures/reservation-enumadd.keiro"),+              ("test/fixtures/contract.keiro", "test/fixtures/contract-fieldadd.keiro"),+              ("test/fixtures/reservation-work.keiro", "test/fixtures/reservation-work-rename.keiro")+            ]+      forM_ changes $ \change ->+        do+          deriveLabel defaultGate ((kindOfChange change).vector)+            `shouldBe` labelOfChange change+          gatedBreaking defaultGate change `shouldBe` isBreaking change+    it "never removes a breaking result when the gate grows" $+      property $+        forAll genCompatibilityVector $ \compatibility ->+          forAll genSurfaceSet $ \gate ->+            forAll genSurfaceSet $ \extra ->+              deriveLabel gate compatibility+                == LabelBreaking+                  ==> deriveLabel (gate <> extra) compatibility+                == LabelBreaking+    it "renders the consumer-neutral matrix with separate private, snapshot, and public surfaces" $ do+      baseChanges <- diffFixtures "test/fixtures/compatibility-vector-old.keiro" "test/fixtures/compatibility-vector-new.keiro"+      nominalChanges <-+        diffFixtures+          "test/fixtures/structural-nominal-leaves.keiro"+          "test/fixtures/structural-nominal-leaves-prefix-change.keiro"+      let selectedNominalSubjects =+            [ "TemplateCatalog event TemplateRecorded .state : TemplateState .templateId : TemplateId via TemplateState",+              "TemplateCatalog register book : TemplateBook .byKey {} : TemplateId via TemplateBook",+              "workqueue template_work payload .templateId : TemplateId",+              "readmodel template_lookup query result : TemplateId []"+            ]+          changes =+            baseChanges+              <> [ change+                 | change <- nominalChanges,+                   changeCode change == IdPrefixChanged,+                   (.subject) (kindOfChange change) `elem` selectedNominalSubjects+                 ]+      let rendered = T.intercalate "\n" (map renderFinding changes)+          explained = T.intercalate "\n" (map renderExplainBlock changes)+          reportJson = T.pack (show (Aeson.toJSON (diffReport defaultGate changes)))+      assertMatchesGolden "test/fixtures/compatibility-vector.diff.golden" rendered+      rendered `shouldSatisfy` T.isInfixOf "Reservation.event.TransferReservationCreated.patientAcuity"+      rendered `shouldSatisfy` T.isInfixOf "old-binary-read-new-events=breaking"+      rendered `shouldSatisfy` T.isInfixOf "snapshot-hydration=advisory"+      rendered `shouldSatisfy` T.isInfixOf "public-consumer=breaking"+      explained `shouldSatisfy` T.isInfixOf "invalidate and rebuild snapshots"+      reportJson `shouldSatisfy` T.isInfixOf "keiro-dsl/diff-report/1"+      reportJson `shouldSatisfy` T.isInfixOf "Reservation.event.TransferReservationCreated.patientAcuity"+      let eventEnumFindings =+            [ change+            | change@(Advisory kind) <- changes,+              (.code) kind == EnumCtorAdded,+              verdictFor OldBinaryReadNewEvents (kind.vector) == VBreaking+            ]+      eventEnumFindings `shouldSatisfy` all (not . gatedBreaking defaultGate)+      eventEnumFindings `shouldSatisfy` all (gatedBreaking (gateWith [OldBinaryReadNewEvents]))+      forM_ changes $ \change ->+        remediationFor ((kindOfChange change).context) ((.code) (kindOfChange change))+          `shouldSatisfy` (not . null)+    it "rejects unknown --gate values with the valid surface list" $ do+      parseSurfaceName "mystery-surface"+        `shouldSatisfy` either (T.isInfixOf "old-binary-read-new-events" . T.pack) (const False)+    it "covers the mapped evolution matrix with stable codes and non-empty remedies" $ do+      let cases =+            [ ("consumer-types-fieldadd-default.keiro", MappedFieldAddedWithDefault),+              ("consumer-types-fieldadd-nodefault.keiro", MappedFieldAddedNoDefault),+              ("consumer-types-fieldremove.keiro", MappedFieldRemoved),+              ("consumer-types-wirekey.keiro", MappedWireKeyChanged),+              ("consumer-types-haskell-rename.keiro", MappedHaskellSourceChanged),+              ("consumer-types-binding-change.keiro", MappedBindingChanged),+              ("consumer-types-fixtures-change.keiro", MappedFixturesChanged),+              ("consumer-types-initial-change.keiro", MappedInitialChanged),+              ("consumer-types-armadd.keiro", MappedArmAdded),+              ("consumer-types-tagchange.keiro", MappedArmTagChanged),+              ("consumer-types-enumadd.keiro", MappedEnumValueAdded),+              ("consumer-types-enumremove.keiro", MappedEnumValueRemoved),+              ("consumer-types-enumspelling.keiro", MappedEnumSpellingChanged),+              ("consumer-types-encoding.keiro", MappedUnionEncodingChanged),+              ("consumer-types-opaque-version.keiro", MappedOpaqueCodecChanged),+              ("consumer-types-mode-cross.keiro", MappedModeCrossed),+              ("consumer-types-nested-propagation.keiro", MappedArmTagChanged)+            ]+      forM_ cases $ \(fixture, expectedCode) -> do+        changes <- diffFixtures "test/fixtures/consumer-types.keiro" ("test/fixtures/" <> fixture)+        map ((.code) . kindOfChange) changes `shouldContain` [expectedCode]+        forM_ changes $ \change ->+          remediationFor ((kindOfChange change).context) ((.code) (kindOfChange change))+            `shouldSatisfy` (not . null)+    it "classifies nested nominal changes at event, snapshot, queue, and query boundaries" $ do+      prefixChanges <-+        diffFixtures+          "test/fixtures/structural-nominal-leaves.keiro"+          "test/fixtures/structural-nominal-leaves-prefix-change.keiro"+      let prefixFindings = [kindOfChange change | change <- prefixChanges, changeCode change == IdPrefixChanged]+          prefixFacets = map (.facet) prefixFindings+      forM_ ["nominal-structural-event", "nominal-structural-register", "nominal-workqueue", "nominal-query-input", "nominal-query-result"] $ \facet ->+        prefixFacets `shouldContain` [facet]+      map (.subject) [finding | finding <- prefixFindings, (.facet) finding == "nominal-structural-event"]+        `shouldContain` ["TemplateCatalog event TemplateRecorded .state : TemplateState .templateId : TemplateId via TemplateState"]+      map (.subject) [finding | finding <- prefixFindings, (.facet) finding == "nominal-structural-register"]+        `shouldContain` ["TemplateCatalog register book : TemplateBook .byKey {} : TemplateId via TemplateBook"]+      forM_ [finding | finding <- prefixFindings, (.facet) finding `elem` ["nominal-query-input", "nominal-query-result"]] $ \finding -> do+        verdictFor ConsumerBuild (finding.vector) `shouldBe` VAdvisory+        verdictFor PrivateHistoryRead (finding.vector) `shouldBe` VCompatible+        verdictFor SnapshotHydration (finding.vector) `shouldBe` VNotApplicable++      bindingChanges <-+        diffFixtures+          "test/fixtures/structural-nominal-leaves.keiro"+          "test/fixtures/structural-nominal-leaves-binding-change.keiro"+      let bindingFindings = [kindOfChange change | change <- bindingChanges, changeCode change == NominalBindingChanged]+      forM_ ["nominal-structural-event", "nominal-structural-register", "nominal-workqueue", "nominal-query-input"] $ \facet ->+        map (.facet) bindingFindings `shouldContain` [facet]+      forM_+        [ "TemplateCatalog event TemplateRecorded .state : TemplateState .holder optional : ClaimId via TemplateState",+          "TemplateCatalog register book : TemplateBook .holders [] optional : ClaimId via TemplateBook",+          "workqueue template_work payload .holder : ClaimId optional"+        ]+        $ \subject -> map (.subject) bindingFindings `shouldContain` [subject]++      enumChanges <-+        diffFixtures+          "test/fixtures/structural-nominal-leaves.keiro"+          "test/fixtures/structural-nominal-leaves-enum-spelling.keiro"+      let spellingFindings = [kindOfChange change | change <- enumChanges, changeCode change == EnumWireSpellingChanged]+      forM_ ["nominal-structural-event", "nominal-structural-register", "nominal-query-input"] $ \facet ->+        map (.facet) spellingFindings `shouldContain` [facet]+      map (.subject) [finding | finding <- spellingFindings, (.facet) finding == "nominal-structural-event"]+        `shouldContain` ["TemplateCatalog event TemplateRecorded .state : TemplateState .channel : Channel via TemplateState"]++      textChanges <-+        diffFixtures+          "test/fixtures/structural-nominal-leaves-text-to-nominal.keiro"+          "test/fixtures/structural-nominal-leaves.keiro"+      opaqueChanges <-+        diffFixtures+          "test/fixtures/structural-nominal-leaves-opaque-to-nominal.keiro"+          "test/fixtures/structural-nominal-leaves.keiro"+      map changeCode textChanges `shouldContain` [MappedFieldTypeChanged]+      map changeCode opaqueChanges `shouldContain` [MappedFieldTypeChanged]+    it "separates mapped event migration, snapshot invalidation, and directional rollout" $ do+      breakingAdd <- diffFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-fieldadd-nodefault.keiro"+      let noDefault = [change | change <- breakingAdd, (.code) (kindOfChange change) == MappedFieldAddedNoDefault]+      [(.facet) kind | Breaking kind <- noDefault] `shouldContain` ["mapped-event"]+      [(.facet) kind | Advisory kind <- noDefault] `shouldContain` ["mapped-register"]+      defaulted <- diffFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-fieldadd-default.keiro"+      [change | change <- defaulted, isBreaking change] `shouldBe` []+      let eventDefaults = [kind | Advisory kind <- defaulted, (.code) kind == MappedFieldAddedWithDefault, (.facet) kind == "mapped-event"]+      eventDefaults `shouldSatisfy` any ((== VBreaking) . verdictFor OldBinaryReadNewEvents . (.vector))+      armAdded <- diffFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-armadd.keiro"+      [change | change <- armAdded, isBreaking change] `shouldBe` []+      [kind | Advisory kind <- armAdded, (.code) kind == MappedArmAdded, (.facet) kind == "mapped-event"]+        `shouldSatisfy` any ((== VBreaking) . verdictFor OldBinaryReadNewEvents . (.vector))+    it "classifies mapped queue history without borrowing event or snapshot surfaces" $ do+      source <- mappedConsumerSurfaceSource+      base <- parseInlineSpec "<mapped-queue-diff-old>" source+      let candidate = mapArtifactNamedField "key" (wireFieldWithKey "artifact_key_v2") base+          queueFindings =+            [ kind+            | change <- diffSpecs base candidate,+              let kind = kindOfChange change,+              (.facet) kind == "mapped-workqueue"+            ]+      queueFindings `shouldSatisfy` (not . null)+      forM_ queueFindings $ \kind -> do+        verdictFor PrivateHistoryRead (kind.vector) `shouldBe` VNotApplicable+        verdictFor OldBinaryReadNewEvents (kind.vector) `shouldBe` VNotApplicable+        verdictFor SnapshotHydration (kind.vector) `shouldBe` VNotApplicable+        verdictFor ConsumerBuild (kind.vector) `shouldBe` VBreaking+        (.rollout) (kind.vector) `shouldBe` Set.fromList [RolloutWorkersFirst, RolloutDrainRequired]+        (.mappedPersistedImpact) kind+          `shouldBe` Just (MappedPersistedImpact (WorkqueueHistory "ArtifactJobs") VBreaking)+        (.detail) kind `shouldSatisfy` T.isInfixOf "schema-version-1 history"+        remediationFor (kind.context) ((.code) kind)+          `shouldSatisfy` all (`elem` [RemedyDeploymentOrder RolloutWorkersFirst, RemedyDrainWorkqueue, RemedyTransitionalQueueCodec, RemedyRecompileConsumers, RemedyRunConformance])+    it "propagates a nested mapped leaf to complete command, event, and register paths" $ do+      changes <- diffFixtures "test/fixtures/consumer-types.keiro" "test/fixtures/consumer-types-nested-propagation.keiro"+      let subjects =+            [ (.subject) kind+            | change <- changes,+              let kind = kindOfChange change,+              (.code) kind == MappedArmTagChanged+            ]+      subjects+        `shouldContain` [ "Catalog command ObserveArtifact .artifact : ArtifactInfo .location : ArtifactLocation .arm RepoPath[\"repository_path\"]",+                          "Catalog event ArtifactObserved .artifact : ArtifactInfo .location : ArtifactLocation .arm RepoPath[\"repository_path\"]",+                          "Catalog register currentArtifact : ArtifactInfo .location : ArtifactLocation .arm RepoPath[\"repository_path\"]"+                        ]+    it "classifies every remaining mapped field and declaration evolution row" $ do+      base <- specOf "test/fixtures/consumer-types.keiro"+      let mutationCodes =+            [ (mapArtifactNamedField "key" (wireFieldWithValueType TInt) base, MappedFieldTypeChanged),+              (mapArtifactNamedField "key" (wireFieldWithPresenceAndDefault POptional (Just (OmText ""))) base, MappedPresenceChanged),+              (mapArtifactNamedField "key" (wireFieldWithValueType (TOptional TText)) base, MappedNullabilityChanged),+              (mapArtifactNamedField "description" (wireFieldWithOnMissing Nothing) base, MappedDefaultRemoved),+              (mapArtifactNamedField "count" (wireFieldWithOnMissing (Just (OmInt 1))) base, MappedDefaultChanged),+              (mapMappedStructural "ArtifactInfo" renameMappedRecordConstructor base, MappedRecordConstructorChanged),+              (mapMappedStructural "ArtifactInfo" changeMappedCanonical base, MappedCanonicalTypeChanged)+            ]+      forM_ mutationCodes $ \(candidate, expectedCode) ->+        map ((.code) . kindOfChange) (diffSpecs base candidate) `shouldContain` [expectedCode]+      let declarationA = completeStructural "A" (recordShape [TText])+          declarationB = completeStructural "B" (recordShape [TInt])+          onlyA = mappedSpec [declarationA]+          withB = mappedSpec [declarationA, declarationB]+      map ((.code) . kindOfChange) (diffSpecs onlyA withB) `shouldContain` [MappedDeclAdded]+      map ((.code) . kindOfChange) (diffSpecs withB onlyA) `shouldContain` [MappedDeclRemoved]+      diffSpecs base (mapArtifactNamedField "key" (wireFieldWithHaskell "renamedKey") base)+        `shouldSatisfy` \case+          [Advisory change] -> (.code) change == GeneratedHaskellNameChanged+          _ -> False+    it "visits every mapped wire mutation and reports every complete root path" $ do+      base <- specOf "test/fixtures/consumer-types.keiro"+      let mutations = mappedWireMutations base+      mutations `shouldSatisfy` (not . null)+      visited <- fmap Set.unions . forM mutations $ \mutation -> do+        let changes =+              [ change+              | change <- diffSpecs base ((.mmCandidate) mutation),+                (.code) (kindOfChange change) == (.mmCode) mutation+              ]+            actualSubjects = Set.fromList (map ((.subject) . kindOfChange) changes)+        changes `shouldSatisfy` any (not . isAdditiveChange)+        actualSubjects `shouldBe` (.mmExpectedSubjects) mutation+        pure actualSubjects+      visited `shouldBe` Set.unions (map (.mmExpectedSubjects) mutations)+    it "reports the exact ingredient code when every required mapped fact is deleted" $ do+      base <- specOf "test/fixtures/consumer-types.keiro"+      forM_ (mappedIngredientMutations base) $ \(candidate, expectedCode) ->+        errorCodes candidate `shouldContain` [expectedCode]+    it "classifies a field added without a version bump as BREAKING" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-fieldadd.keiro"+      any isBreaking cs `shouldBe` True+      [(.code) k | Breaking k <- cs] `shouldContain` [EvtFieldAddedWithoutBump]+    it "classifies the same field wrapped as v2 + upcaster as ADDITIVE" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-v2.keiro"+      any isBreaking cs `shouldBe` False+      [ck | Additive ck <- cs] `shouldSatisfy` any ((== "TransferReservationCreated") . (.subject))+    it "reports no breaking change when the spec is unchanged" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation.keiro"+      any isBreaking cs `shouldBe` False+    it "classifies a direct event field type change as EvtFieldTypeChanged" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-fieldtype.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [EvtFieldTypeChanged]+    it "resolves fields(Command) before comparing event field types" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-cmdfieldtype.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [EvtFieldTypeChanged]+    it "uses EvtFieldRemovedSameVersion for an unchanged-version removal" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-fieldremove.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [EvtFieldRemovedSameVersion]+    it "classifies selector aliases as build-only and wire aliases as replay-affecting" $ do+      let sourceFor field =+            T.unlines+              [ "language keiro-dsl 4",+                "context field-alias-diff",+                "aggregate AliasDiff",+                "  regs",+                "  states Open",+                "  command Observe { " <> field <> " }",+                "  event Observed = fields(Observe)",+                "  wire kind=ctorName fields=camelCase schemaVersion=1"+              ]+      base <- checkedServiceFromText "field-alias-diff-base.keiro" (sourceFor "region:Text")+      selectorAlias <- checkedServiceFromText "field-alias-diff-selector.keiro" (sourceFor "region haskell serviceRegion:Text")+      wireAlias <- checkedServiceFromText "field-alias-diff-wire.keiro" (sourceFor "region as \"region_code\":Text")+      let selectorChanges = diffServices base selectorAlias+          wireChanges = diffServices base wireAlias+          selectorFindings = [finding | Advisory finding <- selectorChanges, (.code) finding == GeneratedHaskellNameChanged]+          wireFindings = [finding | Breaking finding <- wireChanges, (.code) finding == EvtFieldWireKeyChanged]+      selectorChanges `shouldSatisfy` all (not . isBreaking)+      map (.facet) selectorFindings `shouldContain` ["command-field-selector", "event-field-selector"]+      map (verdictFor ConsumerBuild . (.vector)) selectorFindings `shouldSatisfy` all (== VAdvisory)+      resolvedFold (ReplayImpact.replayImpactServices base selectorAlias) `shouldBe` ReplayNeutral+      case wireFindings of+        [finding] -> do+          (.subject) finding `shouldBe` "Observed.region"+          verdictFor PrivateHistoryRead (finding.vector) `shouldBe` VBreaking+          verdictFor OldBinaryReadNewEvents (finding.vector) `shouldBe` VBreaking+          (.detail) finding `shouldSatisfy` T.isInfixOf "'region' -> 'region_code'"+        findings -> expectationFailure ("expected one event wire-key finding, got " <> show findings)+      resolvedFold (ReplayImpact.replayImpactServices base wireAlias)+        `shouldSatisfy` \case+          ReplayAffected impacts ->+            maybe False ((== Set.singleton "Observed") . (.eventTypes)) (Map.lookup "AliasDiff" impacts)+          ReplayNeutral -> False+    it "retains event selector advisories across a legal version bump" $ do+      let sourceFor eventDeclaration =+            T.unlines+              [ "language keiro-dsl 4",+                "context field-alias-version-diff",+                "aggregate AliasVersionDiff",+                "  regs",+                "  states Open",+                "  command Observe {}",+                eventDeclaration+              ]+      base <- checkedServiceFromText "field-alias-version-base.keiro" (sourceFor "  event Observed { region:Text }")+      bumped <-+        checkedServiceFromText+          "field-alias-version-bumped.keiro"+          (sourceFor "  event Observed v2 { region haskell serviceRegion:Text }\n    upcast from v1 = HOLE")+      let changes = diffServices base bumped+          selectorFindings = [finding | Advisory finding <- changes, (.code) finding == GeneratedHaskellNameChanged]+      [(.code) finding | Additive finding <- changes] `shouldContain` [VersionBumped]+      map (.facet) selectorFindings `shouldBe` ["event-field-selector"]+      map (verdictFor ConsumerBuild . (.vector)) selectorFindings `shouldBe` [VAdvisory]+    it "classifies contract selector aliases separately from public wire changes" $ do+      let sourceFor field =+            T.unlines+              [ "language keiro-dsl 4",+                "context contract-field-alias-diff",+                "contract emergency {",+                "  schemaVersion 1",+                "  discriminator messageType",+                "  topic events \"emergency.events\"",+                "  event IncidentDeclared on events {",+                "    " <> field,+                "  }",+                "}"+              ]+      base <- checkedServiceFromText "contract-field-alias-base.keiro" (sourceFor "region: text")+      selectorAlias <- checkedServiceFromText "contract-field-alias-selector.keiro" (sourceFor "region haskell serviceRegion: text")+      wireAlias <- checkedServiceFromText "contract-field-alias-wire.keiro" (sourceFor "region as \"region_code\": text")+      let selectorChanges = diffServices base selectorAlias+          wireChanges = diffServices base wireAlias+      selectorChanges `shouldSatisfy` \case+        [Advisory finding] ->+          (.code) finding == GeneratedHaskellNameChanged+            && (.facet) finding == "contract-field-selector"+            && verdictFor ConsumerBuild (finding.vector) == VAdvisory+        _ -> False+      case [finding | Breaking finding <- wireChanges, (.code) finding == ContractFieldChanged] of+        [finding] -> do+          verdictFor PublicConsumer (finding.vector) `shouldBe` VBreaking+          (.rollout) (finding.vector) `shouldBe` Set.singleton RolloutProducerLast+          (.detail) finding `shouldSatisfy` T.isInfixOf "consumer-first rollout"+        findings -> expectationFailure ("expected one contract wire-key finding, got " <> show findings)+    it "keeps an alias-free field rename on the existing add/remove path" $ do+      let sourceFor field =+            T.unlines+              [ "language keiro-dsl 4",+                "context field-rename-diff",+                "aggregate RenameDiff",+                "  regs",+                "  states Open",+                "  event Renamed { " <> field <> ":Text }",+                "  wire kind=ctorName fields=camelCase schemaVersion=1"+              ]+      old <- checkedServiceFromText "field-rename-old.keiro" (sourceFor "region")+      new <- checkedServiceFromText "field-rename-new.keiro" (sourceFor "zone")+      let changes = diffServices old new+      [(.code) finding | Breaking finding <- changes]+        `shouldContain` [EvtFieldAddedWithoutBump, EvtFieldRemovedSameVersion]+      [finding | Advisory finding <- changes, (.code) finding == GeneratedHaskellNameChanged]+        `shouldBe` []+    it "uses EvtVersionDecreased for a version decrease" $ do+      cs <- diffFixtures "test/fixtures/reservation-v2.keiro" "test/fixtures/reservation.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [EvtVersionDecreased]+    it "rejects a v1 to v3 jump whose only upcaster starts at v2" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-v3-dangling.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [EvtVersionMissingUpcaster]+    it "classifies a vanished historical upcaster rung as UpcasterChainGap" $ do+      cs <- diffFixtures "test/fixtures/reservation-v2.keiro" "test/fixtures/reservation-chain-gap.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [UpcasterChainGap]+    it "classifies an enum constructor removal as EnumCtorRemoved" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-enumdrop.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [EnumCtorRemoved]+    it "classifies an enum wire-spelling change as EnumWireSpellingChanged" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-enumwire.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [EnumWireSpellingChanged]+    it "classifies an enum constructor addition per use site as advisory" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-enumadd.keiro"+      any isBreaking cs `shouldBe` False+      let enumFindings = [k | Advisory k <- cs, (.code) k == EnumCtorAdded]+      [(.subject) k | k <- enumFindings] `shouldContain` ["BlackTag"]+      [verdictFor SnapshotHydration (k.vector) | k <- enumFindings]+        `shouldContain` [VAdvisory]+    it "classifies an effective wire convention change as WireSpecChanged" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-wire.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [WireSpecChanged]+    it "advises when the aggregate fold surface changes" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-foldchange.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldContain` [AggFoldSurfaceChanged]+    it "advises on hazardous deprecation and reports un-deprecation" $ do+      deprecated <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-deprecated.keiro"+      any isBreaking deprecated `shouldBe` False+      [(.code) k | Advisory k <- deprecated] `shouldContain` [DeprecatedEventReplayHazard]+      restored <- diffFixtures "test/fixtures/reservation-deprecated.keiro" "test/fixtures/reservation.keiro"+      any isAdvisory restored `shouldBe` True+      [(.code) k | Advisory k <- restored] `shouldContain` [EventUndeprecated]+    it "recognises replay-only deprecation as a replay-safe retirement cutover" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-deprecated-replay-only.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldContain` [EventRetirementInProgress]+      [(.code) k | Advisory k <- cs] `shouldNotContain` [DeprecatedEventReplayHazard]+    it "advises when event retirement starts" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-retiring.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldContain` [EventRetirementInProgress]+    it "does not recommend decode-only deprecation for an event removal" $ do+      old <- specOf "test/fixtures/reservation.keiro"+      let new =+            specWithNodes+              [ case node of+                  NAggregate aggregate ->+                    NAggregate+                      aggregate+                        { events =+                            [ event+                            | event <- (.events) aggregate,+                              (.name) event /= "TransferReservationConfirmed"+                            ],+                          transitions =+                            [ transition {emits = filter (/= "TransferReservationConfirmed") ((.emits) transition)}+                            | transition <- (.transitions) aggregate+                            ]+                        }+                  _ -> node+              | node <- old.nodes+              ]+              old+          removals = [change | change@(Breaking kind) <- diffSpecs old new, (.code) kind == EvtRemovedNotDeprecated]+      removals `shouldSatisfy` (not . null)+      [(.detail) kind | Breaking kind <- removals]+        `shouldSatisfy` all (not . T.isInfixOf "so old payloads still decode")+    it "prints a paste-ready replay-only twin when a guard tightens (plan 143)" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-guard-tightened.keiro"+      any isBreaking cs `shouldBe` False+      let advisories = [k | Advisory k <- cs, (.code) k == AggGuardTightened]+      map (.subject) advisories `shouldBe` ["Unrequested -- RequestTransferReservation"]+      advisoryDetail <- case advisories of+        [k] -> pure ((.detail) k)+        other -> expectationFailure ("expected one advisory, got " <> show other) >> pure ""+      advisoryDetail `shouldSatisfy` T.isInfixOf "replay-only Unrequested -- RequestTransferReservation"+      -- The printed twin is paste-ready: appended to the new spec it+      -- parses, validates without errors, and silences the advisory.+      tightened <- readTestText "test/fixtures/reservation-guard-tightened.keiro"+      let twinText = snd (T.breakOnEnd "\n\n" advisoryDetail)+          pasted = tightened <> "\n" <> twinText <> "\n"+      case parseSpec "<pasted-twin>" pasted of+        Left err -> expectationFailure (T.unpack err)+        Right pastedSpec -> do+          [(.code) d | d <- validateSpec pastedSpec, (.severity) d == Error] `shouldBe` []+          base <- specOf "test/fixtures/reservation.keiro"+          [k | Advisory k <- diffSpecs base pastedSpec, (.code) k == AggGuardTightened]+            `shouldBe` []+    it "omits the twin advisory when the twin is already present (plan 143)" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-guard-tightened-twin.keiro"+      [k | Advisory k <- cs, (.code) k == AggGuardTightened] `shouldBe` []+    it "classifies a removed contract event as ContractEventRemoved" $ do+      cs <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-eventdrop.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [ContractEventRemoved]+    it "classifies contract field type changes and unversioned additions as ContractFieldChanged" $ do+      changed <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-fieldtype.keiro"+      [(.code) k | Breaking k <- changed] `shouldContain` [ContractFieldChanged]+      added <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-fieldadd.keiro"+      [(.code) k | Breaking k <- added] `shouldContain` [ContractFieldChanged]+    it "links declared contract IDs to prefix evolution and keeps equal-prefix literal migration build-only" $ do+      prefixChanges <-+        diffFixtures+          "test/fixtures/contract-declared-id.keiro"+          "test/fixtures/contract-declared-id-prefix-change.keiro"+      case [finding | Breaking finding <- prefixChanges, (.code) finding == IdPrefixChanged, (.facet) finding == "nominal-contract"] of+        [finding] -> do+          (.subject) finding `shouldBe` "contract templates event TemplateClaimed .templateId"+          verdictFor PublicConsumer (finding.vector) `shouldBe` VBreaking+        findings -> expectationFailure ("expected one public contract prefix finding, got " <> show findings)+      migrationChanges <-+        diffFixtures+          "test/fixtures/contract-declared-id.keiro"+          "test/fixtures/contract-declared-id-literal-to-declared.keiro"+      [finding | Breaking finding <- migrationChanges, (.code) finding == ContractFieldChanged] `shouldBe` []+      case [finding | Advisory finding <- migrationChanges, (.code) finding == ContractFieldChanged] of+        [finding] -> do+          (.subject) finding `shouldBe` "TemplateClaimed.templateId"+          verdictFor PublicConsumer (finding.vector) `shouldBe` VNotApplicable+          verdictFor ConsumerBuild (finding.vector) `shouldBe` VAdvisory+        findings -> expectationFailure ("expected one build-only literal migration finding, got " <> show findings)+    it "freezes the contract TypeID diff report byte contract and rollout" $ do+      let source versionNumber prefix =+            T.unlines+              [ "language keiro-dsl " <> T.pack (show versionNumber),+                "context hospital-capacity",+                "contract emergency {",+                "  schemaVersion 1",+                "  discriminator messageType",+                "  topic incidentEvents \"emergency.incident.events\"",+                "  event IncidentTransferNeedDeclared on incidentEvents {",+                "    incidentId: typeid \"" <> prefix <> "\"",+                "  }",+                "}"+              ]+          checked name input = case parseSource name input of+            Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+            Right parsed -> pure (checkedSource parsed)+      v1 <- checked "contract-typeid-v1.keiro" (source (1 :: Int) "inc")+      v3 <- checked "contract-typeid-v3.keiro" (source (3 :: Int) "inc")+      v4 <- checked "contract-typeid-v4.keiro" (source (4 :: Int) "inc")+      v4Edited <- checked "contract-typeid-v4-edited.keiro" (source (4 :: Int) "rsv")+      let changes = diffServices v3 v4+          textGolden = T.intercalate "\n" (map renderFinding changes)+          jsonGolden = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReport defaultGate changes)))+          findings = [kind | Breaking kind <- changes, (.code) kind == ContractTypeIdDomainChanged]+      assertMatchesGolden "test/fixtures/contract-typeid-domain.diff.golden" textGolden+      assertMatchesByteGolden "test/fixtures/contract-typeid-domain.diff.json.golden" (TextEncoding.encodeUtf8 jsonGolden)+      case findings of+        [finding] -> do+          verdictFor PublicConsumer (finding.vector) `shouldBe` VBreaking+          verdictFor ConsumerBuild (finding.vector) `shouldBe` VBreaking+          [verdictFor surface (finding.vector) | surface <- [PrivateHistoryRead, OldBinaryReadNewEvents, SnapshotHydration, PersistedIdentity]]+            `shouldBe` replicate 4 VNotApplicable+          (.rollout) (finding.vector) `shouldBe` Set.fromList [RolloutDrainRequired, RolloutProducerFirst]+          deriveLabel (Set.singleton PublicConsumer) (finding.vector) `shouldBe` LabelBreaking+          deriveLabel (Set.singleton ConsumerBuild) (finding.vector) `shouldBe` LabelBreaking+          remediationFor (finding.context) ((.code) finding)+            `shouldBe` RemedyEmitContractTypeIdDomain :| [RemedyDrainLegacyInvalidContractMessages, RemedyRescaffoldContractConsumers, RemedyRunContractConformance]+        values -> expectationFailure ("expected one contract TypeID-domain finding, got " <> show (length values))+      [kind | change <- diffServices v1 v3, let { kind = kindOfChange change }, (.code) kind == ContractTypeIdDomainChanged] `shouldBe` []+      [kind | change <- diffServices v4 v4, let { kind = kindOfChange change }, (.code) kind == ContractTypeIdDomainChanged] `shouldBe` []+      let edited = diffServices v3 v4Edited+      map ((.code) . kindOfChange) edited `shouldContain` [ContractFieldChanged]+      [kind | change <- edited, let { kind = kindOfChange change }, (.code) kind == ContractTypeIdDomainChanged] `shouldBe` []+    it "reports a field addition with a contract version bump as an advisory" $ do+      cs <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-bump-fieldadd.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldContain` [ContractSchemaVersionBumped]+    it "classifies a contract schema version decrease separately" $ do+      cs <- diffFixtures "test/fixtures/contract-bump-fieldadd.keiro" "test/fixtures/contract.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [ContractSchemaVersionDecreased]+    it "classifies contract topic and discriminator changes separately" $ do+      topic <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-topic.keiro"+      [(.code) k | Breaking k <- topic] `shouldContain` [ContractTopicChanged]+      discriminatorChanges <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-discriminator.keiro"+      [(.code) k | Breaking k <- discriminatorChanges] `shouldContain` [ContractDiscriminatorChanged]+    it "classifies a new contract event as additive" $ do+      cs <- diffFixtures "test/fixtures/contract.keiro" "test/fixtures/contract-eventadd.keiro"+      any isBreaking cs `shouldBe` False+      [(.subject) k | Additive k <- cs] `shouldContain` ["IncidentTransferNeedCancelled"]+    it "classifies workqueue wire names, types, and required additions as WqPayloadFieldChanged" $ do+      wire <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-wirename.keiro"+      [(.code) k | Breaking k <- wire] `shouldContain` [WqPayloadFieldChanged]+      fieldTypeChange <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-fieldtype.keiro"+      [(.code) k | Breaking k <- fieldTypeChange] `shouldContain` [WqPayloadFieldChanged]+      required <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-reqfield.keiro"+      [(.code) k | Breaking k <- required] `shouldContain` [WqPayloadFieldChanged]+    -- Adding a payload field is breaking however it is spelled. Generated+    -- decoders read every field with `o .:`, so a job already queued under the+    -- old shape fails to decode against the new one — the "additive, optional+    -- field" classification this test previously asserted described a decoder+    -- that was never generated. See ExecPlan 199.+    it "classifies any new workqueue payload field as breaking for queued jobs" $ do+      cs <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-optfield.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [WqPayloadFieldChanged]+      [(.subject) k | Breaking k <- cs] `shouldContain` ["note"]+      [(.detail) k | Breaking k <- cs, (.subject) k == "note"]+        `shouldSatisfy` any (T.isInfixOf "queued jobs do not contain it")+    it "classifies workqueue ordering changes as breaking delivery-contract changes" $ do+      cs <- diffFixtures "test/fixtures/workqueue-policy-base.keiro" "test/fixtures/workqueue-ordering-change.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [WqOrderingChanged]+      [(.detail) k | Breaking k <- cs, (.code) k == WqOrderingChanged]+        `shouldSatisfy` any (T.isInfixOf "delivery-order contract")+      heads <- diffFixtures "test/fixtures/workqueue-policy-base.keiro" "test/fixtures/workqueue-fifo-heads.keiro"+      [(.detail) k | Breaking k <- heads, (.code) k == WqOrderingChanged]+        `shouldSatisfy` any (T.isInfixOf "fifo-throughput -> fifo-heads")+    it "classifies workqueue provision changes as operational migrations" $ do+      cs <- diffFixtures "test/fixtures/workqueue-policy-base.keiro" "test/fixtures/workqueue-provision-change.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [WqProvisionChanged]+      [(.detail) k | Breaking k <- cs, (.code) k == WqProvisionChanged]+        `shouldSatisfy` any (T.isInfixOf "migrate the existing queue operationally")+    it "classifies workqueue group-key changes as breaking repartitioning" $ do+      cs <- diffFixtures "test/fixtures/workqueue-policy-base.keiro" "test/fixtures/workqueue-group-key-change.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [WqGroupKeyChanged]+      [(.detail) k | Breaking k <- cs, (.code) k == WqGroupKeyChanged]+        `shouldSatisfy` any (T.isInfixOf "re-partitioned")+    it "classifies a process input type change as ProcessInputChanged" $ do+      cs <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-inputtype.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [ProcessInputChanged]+    it "classifies workflow input and output changes as WorkflowShapeChanged" $ do+      input <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-inputfield.keiro"+      [(.code) k | Breaking k <- input] `shouldContain` [WorkflowShapeChanged]+      output <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-output.keiro"+      [(.code) k | Breaking k <- output] `shouldContain` [WorkflowShapeChanged]+    it "classifies workflow relabeling and appends as WorkflowBodyChanged" $ do+      relabeled <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-body.keiro"+      [(.code) k | Breaking k <- relabeled] `shouldContain` [WorkflowBodyChanged]+      appended <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-stepadd.keiro"+      [(.code) k | Breaking k <- appended] `shouldContain` [WorkflowBodyChanged]+      [(.detail) k | Breaking k <- appended, (.code) k == WorkflowBodyChanged]+        `shouldSatisfy` any (T.isInfixOf "new patch guard")+    it "classifies a body addition wholly guarded by a new patch as additive" $ do+      cs <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-evolution-diff.keiro"+      any isBreaking cs `shouldBe` False+      [(.subject) k | Additive k <- cs, (.facet) k == "workflow-patch"] `shouldContain` ["fraud-check-v2"]+      [(.subject) k | Additive k <- cs, (.facet) k == "workflow-continue-as-new"] `shouldContain` ["RolloverSeed"]+    it "classifies removing an existing patch as breaking" $ do+      cs <- diffFixtures "test/fixtures/workflow-evolution-diff.keiro" "test/fixtures/workflow-continue.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [WorkflowPatchRemoved]+      [(.detail) k | Breaking k <- cs, (.code) k == WorkflowPatchRemoved]+        `shouldSatisfy` any (T.isInfixOf "cannot prove")+    it "classifies terminal continueAsNew append as additive and seed drift as breaking" $ do+      appended <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-continue.keiro"+      any isBreaking appended `shouldBe` False+      [(.facet) k | Additive k <- appended] `shouldContain` ["workflow-continue-as-new"]+      changed <- diffFixtures "test/fixtures/workflow-continue.keiro" "test/fixtures/workflow-continue-seed-v2.keiro"+      [(.code) k | Breaking k <- changed] `shouldContain` [WorkflowContinueSeedChanged]+      [(.detail) k | Breaking k <- changed, (.code) k == WorkflowContinueSeedChanged]+        `shouldSatisfy` any (T.isInfixOf "restoreSeed")+    it "classifies a workflow stable-name change as WorkflowStableNameChanged" $ do+      cs <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-rename.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [WorkflowStableNameChanged]+    it "classifies workflow id-derivation changes as DerivedIdentityChanged" $ do+      cs <- diffFixtures "test/fixtures/workflow.keiro" "test/fixtures/workflow-idfield.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [DerivedIdentityChanged]+    it "classifies an id prefix change as IdPrefixChanged" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-idprefix.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [IdPrefixChanged]+    it "classifies intake dedupe key and policy changes as DedupeIdentityChanged" $ do+      policy <- diffFixtures "test/fixtures/intake.keiro" "test/fixtures/intake-dedupepolicy.keiro"+      [(.code) k | Breaking k <- policy] `shouldContain` [DedupeIdentityChanged]+      key <- diffFixtures "test/fixtures/intake.keiro" "test/fixtures/intake-dedupekey.keiro"+      [(.code) k | Breaking k <- key] `shouldContain` [DedupeIdentityChanged]+    it "reports intake decode-posture changes as warnings" $ do+      cs <- diffFixtures "test/fixtures/intake.keiro" "test/fixtures/intake-decode.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldContain` [DecodePostureChanged]+      [(.code) k | Advisory k <- cs] `shouldContain` [IntakePersistenceChanged]+    it "classifies process and timer derivation changes as DerivedIdentityChanged" $ do+      processName <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-procname.keiro"+      [(.code) k | Breaking k <- processName] `shouldContain` [DerivedIdentityChanged]+      timerId <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-timerid.keiro"+      [(.code) k | Breaking k <- timerId] `shouldContain` [DerivedIdentityChanged]+      base <- specOf "test/fixtures/hospital-surge.keiro"+      let categoryChange = diffSpecs base (modifyProcess "HospitalSurge" (\process -> processWithSaga (sagaRefWithCategory "hospitalSurgeV2" process.saga) process) base)+      [(.code) k | Breaking k <- categoryChange] `shouldContain` [DerivedIdentityChanged]+    it "classifies router stable names, keys, and targets as identity-bearing" $ do+      base <- specOf "test/fixtures/incident-paging/incident-paging.keiro"+      let stableName = diffSpecs base (modifyRouter "PagingRouter" (routerWithName "paging-v2") base)+          keyDerivation = diffSpecs base (modifyRouter "PagingRouter" (\router -> routerWithKey (correlateDeclWithVia "otherIdText" router.key) router) base)+          target = diffSpecs base (modifyRouter "PagingRouter" (routerWithTarget "OtherPage") base)+      [(.code) k | Breaking k <- stableName] `shouldContain` [RouterStableNameChanged]+      [(.code) k | Breaking k <- keyDerivation] `shouldContain` [DerivedIdentityChanged]+      [(.code) k | Breaking k <- target] `shouldContain` [DerivedIdentityChanged]+    it "advises on router dispatch-surface changes without making them breaking" $ do+      cs <- diffFixtures "test/fixtures/incident-paging/incident-paging.keiro" "test/fixtures/incident-paging/incident-paging-dispatch.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldBe` [RouterDecideSurfaceChanged]+    it "advises on process dispatch-surface changes without making them breaking" $ do+      cs <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-handle.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldBe` [ProcessDecideSurfaceChanged]+    it "refuses an unreviewed migration between positional and target-keyed process identities" $ do+      forward <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-reactions.keiro"+      backward <- diffFixtures "test/fixtures/hospital-surge-reactions.keiro" "test/fixtures/hospital-surge.keiro"+      [(.code) kind | Breaking kind <- forward] `shouldContain` [ProcessDispatchIdentityModelChanged]+      [(.code) kind | Breaking kind <- backward] `shouldContain` [ProcessDispatchIdentityModelChanged]+      [(.detail) kind | Breaking kind <- forward, (.code) kind == ProcessDispatchIdentityModelChanged]+        `shouldSatisfy` any (T.isInfixOf "docs/user/deploy-ordering.md")+    it "advises on unversioned timer payload changes without making them breaking" $ do+      cs <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-payload.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldBe` [ProcessTimerPayloadChanged]+    it "classifies reaction fan-out, guard, timer, and version evolution" $ do+      source <- readTestText "test/fixtures/process-timers.keiro"+      reactionSource <- readTestText "test/fixtures/process-reactions.keiro"+      stateSource <- readTestText "test/fixtures/process-state-authority.keiro"+      payloadSource <- readTestText "test/fixtures/process-timers-payload-changed.keiro"+      identitySource <- readTestText "test/fixtures/process-timers-identity-changed.keiro"+      baseline <- checkedServiceFromText "process-reaction-diff-base.keiro" source+      reactionBaseline <- checkedServiceFromText "process-reaction-fingerprint-base.keiro" reactionSource+      stateBaseline <- checkedServiceFromText "process-reaction-guard-base.keiro" stateSource+      guardChanged <- checkedServiceFromText "process-reaction-guard-changed.keiro" (T.replace "input.severity == Severity.Sev1" "input.severity == Severity.Sev2" stateSource)+      fanOutChanged <- checkedServiceFromText "process-reaction-diff-fanout.keiro" (T.replace "+ 5m" "+ 10m" source)+      payloadChanged <- checkedServiceFromText "process-reaction-diff-payload.keiro" payloadSource+      identityChanged <- checkedServiceFromText "process-reaction-diff-identity.keiro" identitySource+      ceilingChanged <- checkedServiceFromText "process-reaction-diff-ceiling.keiro" (T.replace "max-attempts 5" "max-attempts 7" source)+      deadLetterChanged <- checkedServiceFromText "process-reaction-diff-dead-letter.keiro" (T.replace "dead-letter \"incident timer exceeded ceiling\"" "dead-letter \"incident timer exceeded ceiling v2\"" source)+      versionedFanOut <- checkedServiceFromText "process-reaction-diff-versioned.keiro" (T.replace "reactions version 1" "reactions version 2" (T.replace "+ 5m" "+ 10m" source))+      versionTwo <- checkedServiceFromText "process-reaction-diff-version-two.keiro" (T.replace "reactions version 1" "reactions version 2" source)+      withoutAck <-+        checkedServiceFromText+          "process-reaction-diff-removed.keiro"+          ( T.replace+              "  input ResponderAcked { incidentId:IncidentId }\n"+              ""+              (T.replace "  on ResponderAcked\n    cancel reminder\n\n" "" source)+          )+      withoutReminder <-+        checkedServiceFromText+          "process-reaction-diff-timer-removed.keiro"+          ( T.replace+              "    schedule reminder once fireAt input.raisedAt + 60m { incidentId }\n"+              ""+              ( T.replace+                  "  on ResponderAcked\n    cancel reminder\n"+                  "  on ResponderAcked\n    no-action\n"+                  (T.replace "\n  timer reminder\n    id uuidv5 \"incident-reminder-timer:\" <> correlationId\n    payload { kind=\"reminder\" incidentId:IncidentId }\n    fire dispatch Incident@correlationId RemindIncident { incidentId }\n      fired-event-id uuidv5 \"incident-reminder-fired:\" <> correlationId\n      on-ok Fired ; on-reject Fired ; on-ambiguous Retry ; on-error Retry ; not-mine Retry\n    decode unknown-status => Cancelled\n" "" source)+              )+          )+      let changes old new = resolvedFold (CheckedDiff.diffServices old new)+          codes select old new = [(.code) kind | change <- changes old new, kind <- [kindOfChange change], select change]+          finding code old new = find ((== code) . (.code) . kindOfChange) (changes old new)+          fingerprints service =+            [ (process.name, processReactionFingerprintFrom reaction)+            | NProcess process <- (checkedSpec service).nodes,+              ReactionProcessBody reaction <- [process.body]+            ]+      fingerprints baseline+        `shouldBe` [("incident-timers", "5a6afd7c9691c5716a9c7b3140b5c6c54ff8689aa6e0fbc9acf576ce56aa4904")]+      fingerprints reactionBaseline+        `shouldBe` [ ("incident-reaction", "dff4a685084373ac102b8fa9591bc4cdbaa358a19bdec488ea157bd038421573"),+                     ("audit-only", "a98c341339b007c1e28edff6a1a89b91a9dd3ac63c83bfe57e6b41479d84af96"),+                     ("scaling-reaction", "8329eab62dfa1917a468c914b9bbb7cae121b5d353656e69543f6aa95a43a14f")+                   ]+      codes isAdvisory baseline fanOutChanged `shouldContain` [ProcessReactionFanOutChanged]+      codes isAdvisory stateBaseline guardChanged `shouldContain` [ProcessReactionGuardChanged]+      codes isBreaking baseline fanOutChanged `shouldContain` [ProcessReactionFingerprintChangedWithoutVersionBump]+      codes isAdvisory baseline payloadChanged `shouldContain` [ProcessTimerPayloadChanged]+      codes isBreaking baseline identityChanged `shouldContain` [ProcessTimerIdentityChanged]+      codes isBreaking baseline ceilingChanged `shouldBe` []+      codes isAdvisory baseline ceilingChanged `shouldBe` [ProcessTimerCeilingChanged]+      codes isBreaking baseline deadLetterChanged `shouldBe` []+      codes isAdvisory baseline deadLetterChanged `shouldBe` [ProcessTimerCeilingChanged]+      codes isAdvisory baseline versionedFanOut `shouldContain` [ProcessReactionFingerprintChangedWithVersionBump]+      codes isBreaking baseline versionedFanOut `shouldBe` []+      codes isBreaking versionTwo baseline `shouldContain` [ProcessReactionVersionDecreased]+      codes isAdvisory baseline withoutAck `shouldContain` [ProcessReactionRemoved]+      codes isAdditiveChange withoutAck baseline `shouldContain` [ProcessReactionAdded]+      codes isBreaking baseline withoutReminder `shouldContain` [ProcessTimerRemoved]+      codes isAdditiveChange withoutReminder baseline `shouldContain` [ProcessTimerAdded]+      case finding ProcessReactionFanOutChanged baseline fanOutChanged of+        Just change -> do+          let kind = kindOfChange change+          (.rollout) kind.vector `shouldBe` Set.singleton RolloutDrainRequired+          remediationFor kind.context kind.code `shouldSatisfy` (\case RemedyDeploymentOrder RolloutDrainRequired :| _ -> True; _ -> False)+        Nothing -> expectationFailure "expected ProcessReactionFanOutChanged"+      case finding ProcessTimerRemoved baseline withoutReminder of+        Just change -> do+          verdictFor PersistedIdentity ((.vector) (kindOfChange change)) `shouldBe` VBreaking+          verdictFor PrivateHistoryRead ((.vector) (kindOfChange change)) `shouldBe` VNotApplicable+        Nothing -> expectationFailure "expected ProcessTimerRemoved"+    it "classifies reaction arm reordering by ordinal and requires a version bump" $ do+      baselineSource <- readTestText "test/fixtures/process-reactions-diff.keiro"+      reorderedSource <- readTestText "test/fixtures/process-reactions-reordered.keiro"+      unversionedSource <- readTestText "test/fixtures/process-reactions-reordered-unversioned.keiro"+      fanOutSource <- readTestText "test/fixtures/process-reactions-fanout-changed.keiro"+      baseline <- checkedServiceFromText "process-reaction-order-base.keiro" baselineSource+      unversioned <- checkedServiceFromText "process-reaction-order-unversioned.keiro" unversionedSource+      versioned <- checkedServiceFromText "process-reaction-order-versioned.keiro" reorderedSource+      fanOutChanged <- checkedServiceFromText "process-reaction-order-fanout.keiro" fanOutSource+      let unversionedChanges = resolvedFold (CheckedDiff.diffServices baseline unversioned)+          versionedChanges = resolvedFold (CheckedDiff.diffServices baseline versioned)+      [(.code) kind | Advisory kind <- unversionedChanges] `shouldContain` [ProcessReactionArmsReordered]+      [(.code) kind | Breaking kind <- unversionedChanges] `shouldContain` [ProcessReactionFingerprintChangedWithoutVersionBump]+      [(.code) kind | Advisory kind <- versionedChanges] `shouldContain` [ProcessReactionArmsReordered, ProcessReactionFingerprintChangedWithVersionBump]+      any isBreaking versionedChanges `shouldBe` False+      [(.code) kind | Advisory kind <- resolvedFold (CheckedDiff.diffServices baseline fanOutChanged)]+        `shouldContain` [ProcessReactionFanOutChanged, ProcessReactionFingerprintChangedWithVersionBump]+    it "persists reaction coordination snapshots without inventing legacy metadata" $ do+      reactionSource <- readTestText "test/fixtures/process-timers.keiro"+      legacySource <- readTestText "test/fixtures/hospital-surge.keiro"+      reaction <- checkedServiceFromText "process-snapshot-reaction.keiro" reactionSource+      versionTwo <- checkedServiceFromText "process-snapshot-v2.keiro" (T.replace "reactions version 1" "reactions version 2" reactionSource)+      legacy <- checkedServiceFromText "process-snapshot-legacy.keiro" legacySource+      case processReactionSnapshots reaction of+        Right [snapshot] -> do+          (.verification) snapshot `shouldBe` "generated-declarative"+          (.version) snapshot `shouldBe` Just 1+          fmap T.length ((.fingerprint) snapshot) `shouldBe` Just 64+          Aeson.decode (Aeson.encode snapshot) `shouldBe` Just snapshot+        snapshots -> expectationFailure ("expected one process reaction snapshot, got " <> show snapshots)+      case processReactionSnapshots legacy of+        Right [snapshot] -> do+          (.verification) snapshot `shouldBe` "custom-unverified"+          (.version) snapshot `shouldBe` Nothing+          (.fingerprint) snapshot `shouldBe` Nothing+        snapshots -> expectationFailure ("expected one legacy process snapshot, got " <> show snapshots)+      case (processReactionSnapshots reaction, processReactionSnapshots versionTwo) of+        (Right oldSnapshots, Right newSnapshots) -> processReactionDrift oldSnapshots newSnapshots `shouldSatisfy` (not . null)+        snapshots -> expectationFailure ("expected checked reaction snapshots, got " <> show snapshots)+    it "ignores formatting-only process and timer surface rewrites" $ do+      original <- specOf "test/fixtures/hospital-surge.keiro"+      formatted <- shouldParseStableRenderedSpec "<formatted-process>" original+      diffSpecs original formatted `shouldBe` []+    it "reports a timer window change as a warning" $ do+      cs <- diffFixtures "test/fixtures/hospital-surge.keiro" "test/fixtures/hospital-surge-window.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldContain` [TimerWindowChanged]+    it "reports emit-map changes as warnings and derive changes as breaking" $ do+      mapping <- diffFixtures "test/fixtures/emit.keiro" "test/fixtures/emit-mapchange.keiro"+      any isBreaking mapping `shouldBe` False+      [(.code) k | Advisory k <- mapping] `shouldContain` [EmitMappingChanged]+      derive <- diffFixtures "test/fixtures/emit.keiro" "test/fixtures/emit-derive.keiro"+      [(.code) k | Breaking k <- derive] `shouldContain` [DerivedIdentityChanged]+    it "classifies publisher outbox identity and ordering independently" $ do+      outbox <- diffFixtures "test/fixtures/emit.keiro" "test/fixtures/emit-outboxfield.keiro"+      [(.code) k | Breaking k <- outbox] `shouldContain` [DerivedIdentityChanged]+      ordering <- diffFixtures "test/fixtures/emit.keiro" "test/fixtures/emit-ordering.keiro"+      any isBreaking ordering `shouldBe` False+      [(.code) k | Advisory k <- ordering] `shouldContain` [PublisherPolicyChanged]+    it "classifies workqueue names as QueueIdentityChanged" $ do+      cs <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-rename.keiro"+      [(.code) k | Breaking k <- cs] `shouldContain` [QueueIdentityChanged]+    it "classifies pgmq dispatch dedupe and retargeting independently" $ do+      dedupe <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-dedupkey.keiro"+      [(.code) k | Breaking k <- dedupe] `shouldContain` [DedupeIdentityChanged]+      retarget <- diffFixtures "test/fixtures/reservation-work.keiro" "test/fixtures/reservation-work-retarget.keiro"+      any isBreaking retarget `shouldBe` False+      [(.code) k | Advisory k <- retarget] `shouldContain` [DispatchRetargeted]+    it "reports aggregate projection changes as warnings" $ do+      cs <- diffFixtures "test/fixtures/reservation.keiro" "test/fixtures/reservation-projection.keiro"+      any isBreaking cs `shouldBe` False+      [(.code) k | Advisory k <- cs] `shouldContain` [ProjectionChanged]+    it "classifies read-model version and unversioned shape changes" $ do+      base <- specOf "test/fixtures/readmodel-runtime.keiro"+      let versionTwo = modifyReadModel "transfer_decisions" (readModelWithVersion 2) base+          changedShape = modifyReadModel "transfer_decisions" changeReadModelShape base+          bumpedShape = modifyReadModel "transfer_decisions" (readModelWithVersion 2 . changeReadModelShape) base+          decreased = diffSpecs versionTwo base+          unversioned = diffSpecs base changedShape+          bumped = diffSpecs base bumpedShape+      [(.code) k | Breaking k <- decreased] `shouldContain` [ReadModelVersionDecreased]+      [(.code) k | Breaking k <- unversioned] `shouldContain` [ReadModelShapeChangedWithoutBump]+      any isBreaking bumped `shouldBe` False+      [(.facet) k | Additive k <- bumped] `shouldContain` ["read-model-version"]+    it "classifies query input and result changes only on the consumer-build surface" $ do+      source <- mappedConsumerSurfaceSource+      base <- parseInlineSpec "<mapped-query-diff-old>" source+      let changeQuery update =+            modifyReadModel+              "ArtifactLookup"+              ( \readModel ->+                  readModelWithQueryTypes (fmap update readModel.queryTypes) readModel+              )+              base+          inputChanged = changeQuery (\queryPair -> readModelQueryTypesWithInput (TList queryPair.input) queryPair)+          resultChanged = changeQuery (readModelQueryTypesWithResult (TRef "ArtifactInfo"))+          assertBuildOnly expectedCode changes = case [kind | Advisory kind <- changes, (.code) kind == expectedCode] of+            [kind] -> do+              (.consumerBuild) (kind.vector) `shouldBe` VBreaking+              (.privateHistoryRead) (kind.vector) `shouldBe` VCompatible+              (.oldBinaryReadNewEvents) (kind.vector) `shouldBe` VCompatible+              (.snapshotHydration) (kind.vector) `shouldBe` VNotApplicable+              (.publicConsumer) (kind.vector) `shouldBe` VNotApplicable+              (.persistedIdentity) (kind.vector) `shouldBe` VNotApplicable+              (.mappedPersistedImpact) kind `shouldBe` Nothing+              remediationFor (kind.context) ((.code) kind)+                `shouldBe` RemedyRecompileConsumers :| [RemedyRunConformance]+            values -> expectationFailure ("expected one query build finding, got " <> show values)+          onlyReadModel spec = case [readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == "ArtifactLookup"] of+            [readModel] -> readModel+            values -> error ("expected one ArtifactLookup read model, got " <> show values)+      assertBuildOnly ReadModelQueryInputChanged (diffSpecs base inputChanged)+      assertBuildOnly ReadModelQueryResultChanged (diffSpecs base resultChanged)+      canonicalShape (onlyReadModel inputChanged) `shouldBe` canonicalShape (onlyReadModel base)+      deriveShapeHash (onlyReadModel resultChanged) `shouldBe` deriveShapeHash (onlyReadModel base)+      projectionCatalogFacts inputChanged `shouldBe` projectionCatalogFacts base+      registryNameFor (inputChanged.context) (onlyReadModel inputChanged)+        `shouldBe` registryNameFor (base.context) (onlyReadModel base)+      replayImpactSpecs base inputChanged `shouldBe` ReplayNeutral+    it "classifies read-model registry, table, subscription, and removal identities" $ do+      base <- specOf "test/fixtures/readmodel-runtime.keiro"+      let tableChanged = modifyReadModel "transfer_decisions" (readModelWithTable "transfer_decisions_v2") base+          subscriptionChanged = modifyReadModel "transfer_decisions" (\readModel -> readModelWithSupply (setLegacySubscription (Just "transfer-decisions-v2") readModel.supply) readModel) base+          renamed = modifyReadModel "transfer_decisions" (readModelWithName "reservation_decisions") base+          removed = removeReadModel "transfer_decisions" base+      mapM_+        (\changes -> [(.code) k | Breaking k <- changes] `shouldContain` [DerivedIdentityChanged])+        [diffSpecs base tableChanged, diffSpecs base subscriptionChanged, diffSpecs base renamed, diffSpecs base removed]+    it "classifies read-model feed flips and consistency/scope weakening as breaking" $ do+      base <- specOf "test/fixtures/readmodel-runtime.keiro"+      let feedChanged = modifyReadModel "transfer_decisions" (\readModel -> readModel {supply = setLegacyFeed RmInline ((.supply) readModel)}) base+          consistencyWeakened = modifyReadModel "transfer_decisions" (\readModel -> readModel {supply = setLegacyConsistency Eventual ((.supply) readModel), freshness = FreshnessImmediate}) base+          entireLog = modifyReadModel "transfer_decisions" (\readModel -> readModel {supply = setLegacyScope (Just RmEntireLog) ((.supply) readModel), freshness = FreshnessWaitForHead RmEntireLog}) base+      [(.code) k | Breaking k <- diffSpecs base feedChanged] `shouldContain` [ReadModelFeedChanged]+      [(.code) k | Breaking k <- diffSpecs base consistencyWeakened] `shouldContain` [ReadModelConsistencyWeakened]+      [(.code) k | Breaking k <- diffSpecs entireLog base] `shouldContain` [ReadModelConsistencyWeakened]+    it "classifies Eventual to Strong read-model consistency as additive" $ do+      strong <- specOf "test/fixtures/readmodel-runtime.keiro"+      let eventual = modifyReadModel "transfer_decisions" (\readModel -> readModel {supply = setLegacyConsistency Eventual ((.supply) readModel), freshness = FreshnessImmediate}) strong+          changes = diffSpecs eventual strong+      any isBreaking changes `shouldBe` False+      [(.facet) k | Additive k <- changes] `shouldContain` ["read-model-consistency"]+    it "classifies the legacy Strong to language-5 immediate freshness migration as breaking" $ do+      source <- readTestText "test/fixtures/readmodel-migration-l4.keiro"+      let legacyStrongPolicy =+            "  consistency = Strong\n  scope = category \"reservation\"\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"+          toLanguage5 policy =+            T.replace "language keiro-dsl 4" "language keiro-dsl 5"+              . T.replace legacyStrongPolicy policy+      legacyStrong <- checkedServiceFromText "readmodel-migration-legacy-strong.keiro" source+      immediate <- checkedServiceFromText "readmodel-migration-immediate.keiro" (toLanguage5 "  freshness = immediate\n" source)+      let changes = diffServices legacyStrong immediate+      [(.code) k | Breaking k <- changes] `shouldContain` [QueryFreshnessChanged]+      [(.facet) k | Breaking k <- changes] `shouldContain` ["query-freshness"]+      [(.facet) k | Additive k <- changes] `shouldNotContain` ["read-model-scope"]+      [(.detail) k | Breaking k <- changes, (.code) k == QueryFreshnessChanged]+        `shouldSatisfy` any (T.isInfixOf "wait-for-head category 'reservation' -> immediate")+    it "keeps equivalent and strengthened freshness migrations non-breaking" $ do+      source <- readTestText "test/fixtures/readmodel-migration-l4.keiro"+      let legacyStrongPolicy =+            "  consistency = Strong\n  scope = category \"reservation\"\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"+          legacyEventualPolicy =+            "  consistency = Eventual\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"+          toLanguage5 policy =+            T.replace "language keiro-dsl 4" "language keiro-dsl 5"+              . T.replace legacyStrongPolicy policy+          readModelFacets = filter (\facet -> facet == "query-freshness" || "read-model-" `T.isPrefixOf` facet) . map ((.facet) . kindOfChange)+          assertEquivalent changes = do+            any isBreaking changes `shouldBe` False+            readModelFacets changes `shouldBe` []+      legacyStrong <- checkedServiceFromText "readmodel-migration-equivalent-legacy-strong.keiro" source+      strongEquivalent <- checkedServiceFromText "readmodel-migration-equivalent-wait.keiro" (toLanguage5 "  freshness = wait-for-head category \"reservation\"\n" source)+      assertEquivalent (diffServices legacyStrong strongEquivalent)+      let eventualSource = T.replace legacyStrongPolicy legacyEventualPolicy source+      legacyEventual <- checkedServiceFromText "readmodel-migration-equivalent-legacy-eventual.keiro" eventualSource+      immediate <- checkedServiceFromText "readmodel-migration-equivalent-immediate.keiro" (toLanguage5 "  freshness = immediate\n" source)+      assertEquivalent (diffServices legacyEventual immediate)+      strengthened <- checkedServiceFromText "readmodel-migration-strengthened.keiro" (toLanguage5 "  freshness = wait-for-head entire-log\n" source)+      let strengthenedChanges = diffServices legacyEventual strengthened+      any isBreaking strengthenedChanges `shouldBe` False+      [(.code) k | Additive k <- strengthenedChanges] `shouldContain` [CompatibilityStrengthened]+      [(.facet) k | Additive k <- strengthenedChanges] `shouldContain` ["query-freshness"]+    it "classifies scope changes and reverse downgrades in the freshness migration by the normalized pair" $ do+      source <- readTestText "test/fixtures/readmodel-migration-l4.keiro"+      let legacyStrongPolicy =+            "  consistency = Strong\n  scope = category \"reservation\"\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"+          legacyEventualPolicy =+            "  consistency = Eventual\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"+          toLanguage5 policy =+            T.replace "language keiro-dsl 4" "language keiro-dsl 5"+              . T.replace legacyStrongPolicy policy+      legacyStrong <- checkedServiceFromText "readmodel-migration-scope-legacy-strong.keiro" source+      widened <- checkedServiceFromText "readmodel-migration-scope-widened.keiro" (toLanguage5 "  freshness = wait-for-head entire-log\n" source)+      let widenedChanges = diffServices legacyStrong widened+      any isBreaking widenedChanges `shouldBe` False+      [(.code) k | Additive k <- widenedChanges] `shouldContain` [CompatibilityStrengthened]+      [(.facet) k | Additive k <- widenedChanges] `shouldContain` ["query-freshness"]+      categoryChanged <- checkedServiceFromText "readmodel-migration-scope-category-changed.keiro" (toLanguage5 "  freshness = wait-for-head category \"other\"\n" source)+      [(.code) k | Breaking k <- diffServices legacyStrong categoryChanged] `shouldContain` [QueryFreshnessChanged]+      immediate <- checkedServiceFromText "readmodel-migration-reverse-immediate.keiro" (toLanguage5 "  freshness = immediate\n" source)+      let reverseStrengthened = diffServices immediate legacyStrong+      any isBreaking reverseStrengthened `shouldBe` False+      [(.code) k | Additive k <- reverseStrengthened] `shouldContain` [CompatibilityStrengthened]+      legacyEventual <- checkedServiceFromText "readmodel-migration-reverse-legacy-eventual.keiro" (T.replace legacyStrongPolicy legacyEventualPolicy source)+      waitCategory <- checkedServiceFromText "readmodel-migration-reverse-wait.keiro" (toLanguage5 "  freshness = wait-for-head category \"reservation\"\n" source)+      [(.code) k | Breaking k <- diffServices waitCategory legacyEventual] `shouldContain` [QueryFreshnessChanged]+    it "keeps identical same-language freshness migration pairs free of policy findings" $ do+      source <- readTestText "test/fixtures/readmodel-migration-l4.keiro"+      let legacyStrongPolicy =+            "  consistency = Strong\n  scope = category \"reservation\"\n  feed = subscription\n  subscription = \"hospital-capacity-transfer-decisions-sub\"\n"+          language5Source =+            T.replace "language keiro-dsl 4" "language keiro-dsl 5"+              . T.replace legacyStrongPolicy "  freshness = immediate\n"+              $ source+          policyFacets = filter (\facet -> facet == "query-freshness" || "read-model-" `T.isPrefixOf` facet) . map ((.facet) . kindOfChange)+      language4 <- checkedServiceFromText "readmodel-migration-identical-language-4.keiro" source+      language5 <- checkedServiceFromText "readmodel-migration-identical-language-5.keiro" language5Source+      policyFacets (diffServices language4 language4) `shouldBe` []+      policyFacets (diffServices language5 language5) `shouldBe` []++  describe "module placement (M1)" $ do+    it "GeneratedPrefix is today's namespace (Generated.<Ctx>.<Node>, holes at <Ctx>.<Node>)" $ do+      let ctx = defaultContext "hospital-capacity"+      genPrefixFor ctx "Reservation" `shouldBe` "Generated.HospitalCapacity.Reservation"+      holePrefixFor ctx "Reservation" `shouldBe` "HospitalCapacity.Reservation"+    it "module-root prefixes both layers" $ do+      let ctx = contextWithModuleRoot "Acme" (defaultContext "hospital-capacity")+      genPrefixFor ctx "Reservation" `shouldBe` "Acme.Generated.HospitalCapacity.Reservation"+      holePrefixFor ctx "Reservation" `shouldBe` "Acme.HospitalCapacity.Reservation"+    it "CollocatedLeaf places the generated layer under the domain leaf" $ do+      let ctx = (defaultContext "hospital-capacity") {moduleRoot = "Acme", placement = CollocatedLeaf}+      genPrefixFor ctx "Reservation" `shouldBe` "Acme.HospitalCapacity.Reservation.Generated"+      holePrefixFor ctx "Reservation" `shouldBe` "Acme.HospitalCapacity.Reservation"+    it "parses and preserves the module/layout clauses through parse . pretty" $ do+      let src = "context hospital-capacity\nmodule Acme.Services\nlayout collocated\n\naggregate Reservation\n  regs\n  states Open\n"+      case parseSpec "<m1>" src of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> do+          (.moduleRoot) spec `shouldBe` Just "Acme.Services"+          (.layout) spec `shouldBe` Just CollocatedLeaf+          parseSpec "<m1>" (renderSpec spec) `shouldBe` Right spec+    it "a spec without the clauses leaves placement at the default" $ do+      input <- readTestText "test/fixtures/reservation.keiro"+      case parseSpec "test/fixtures/reservation.keiro" input of+        Left err -> expectationFailure (T.unpack err)+        Right spec -> do+          (.moduleRoot) spec `shouldBe` Nothing+          (.layout) spec `shouldBe` Nothing++  describe "structural scaffold" $ do+    it "emits one private shape module per structural declaration and one context facade" $ do+      spec <- specOf "test/fixtures/consumer-types.keiro"+      let modules = scaffoldModules (defaultContext (spec.context)) spec+          paths = map (.path) modules+      paths+        `shouldContain` [ "Generated/ConsumerDemo/Structural/Shape/ArtifactInfo.hs",+                          "Generated/ConsumerDemo/Structural/Shape/ArtifactKind.hs",+                          "Generated/ConsumerDemo/Structural/Shape/ArtifactLocation.hs",+                          "Generated/ConsumerDemo/StructuralProjections.hs"+                        ]+      paths `shouldNotContain` ["Generated/ConsumerDemo/Structural/Shape/VendorGeometry.hs"]+      firewallBreaches modules `shouldBe` []+    it "emits one create-once binding skeleton per owning module and derives Generic for private shapes" $ do+      spec <- specOf "test/fixtures/consumer-types.keiro"+      let modules = scaffoldModules (defaultContext (spec.context)) spec+          skeletons = [moduleValue | moduleValue <- modules, (.kind) moduleValue == HoleStub, (.path) moduleValue == "Example/Artifact/KeiroBindings.hs"]+          shape = generatedTextEndingIn "Structural/Shape/ArtifactInfo.hs" modules+      case skeletons of+        [skeleton] -> do+          (.text) skeleton `shouldSatisfy` T.isInfixOf "artifactInfoBinding :: StructuralBinding"+          (.text) skeleton `shouldSatisfy` T.isInfixOf "artifactKindBinding :: StructuralBinding"+          (.text) skeleton `shouldSatisfy` T.isInfixOf "artifactLocationBinding :: StructuralBinding"+          (.text) skeleton `shouldSatisfy` T.isInfixOf "HOLE: fill ArtifactInfo bindingToShape.key"+        _ -> expectationFailure ("expected exactly one shared binding skeleton, got " <> show (map (.path) skeletons))+      shape `shouldSatisfy` T.isInfixOf "deriving stock (Eq, Generic, Show)"+      shape `shouldSatisfy` T.isInfixOf "import GHC.Generics (Generic)"+    it "never overwrites an existing binding skeleton" $+      withTempDirectory "keiro-dsl-binding-create-once" $ \out -> do+        spec <- specOf "test/fixtures/consumer-types.keiro"+        let ctx = defaultContext (spec.context)+            bindingPath = out </> "Example/Artifact/KeiroBindings.hs"+        _ <- executePlannedScaffold out "consumer-types.keiro" ctx spec+        TIO.writeFile bindingPath "hand-owned binding\n"+        second <- executePlannedScaffold out "consumer-types.keiro" ctx spec+        TIO.readFile bindingPath `shouldReturn` "hand-owned binding\n"+        (.dispositions) second+          `shouldSatisfy` any (\(moduleValue, disposition) -> (.path) moduleValue == "Example/Artifact/KeiroBindings.hs" && disposition == Skipped)+    it "fresh binding skeletons compile at the application boundary" $+      withTempDirectory "keiro-dsl-binding-compiles" $ \out -> do+        spec <- specOf "test/fixtures/structural-conformance.keiro"+        let ctx = defaultContext (spec.context)+            ghcOutput = out </> ".ghc"+            domainSource = out </> "Conformance/Structural/Domain.hs"+        _ <- executePlannedScaffold out "structural-conformance.keiro" ctx spec+        readTestText "test/conformance-structural/Conformance/Structural/Domain.hs"+          >>= writeFileWithParents domainSource+        createDirectoryIfMissing True ghcOutput+        keiroCorePackageId <- activeCabalPackageId "keiro-core"+        keikiPackageId <- activeCabalPackageId "keiki"+        (exitCode, standardOutput, standardError) <-+          readProcessWithExitCode+            "cabal"+            [ "exec",+              "--enable-tests",+              "--",+              "ghc",+              "-XGHC2024",+              "-XOverloadedStrings",+              "-fno-code",+              "-fforce-recomp",+              "-package-id",+              keiroCorePackageId,+              "-package-id",+              keikiPackageId,+              "-outputdir",+              ghcOutput,+              "-i" <> out,+              "-itest/conformance-structural",+              out </> "Conformance/Structural/Bindings.hs"+            ]+            ""+        unless (exitCode == ExitSuccess) $+          expectationFailure (standardOutput <> standardError)+    it "keeps consumer types in Domain while the generated Codec owns keys, tags, and defaults" $ do+      spec <- specOf "test/fixtures/consumer-types.keiro"+      let modules = scaffoldModules (defaultContext (spec.context)) spec+          domain = generatedTextEndingIn "Catalog/Domain.hs" modules+          codec = generatedTextEndingIn "Catalog/Codec.hs" modules+      domain `shouldSatisfy` T.isInfixOf "import Example.Artifact.Domain (ArtifactInfo)"+      domain `shouldSatisfy` T.isInfixOf "import Vendor.Geometry (Geometry)"+      domain `shouldSatisfy` T.isInfixOf "artifact :: !ArtifactInfo"+      domain `shouldSatisfy` T.isInfixOf "RCons (Proxy @\"currentArtifact\") ArtifactKeiroBindings.emptyArtifactInfo"+      domain `shouldSatisfy` (not . T.isInfixOf "Example.Artifact.Domain.ArtifactInfo")+      codec `shouldSatisfy` T.isInfixOf "\"location\" .= encodeArtifactLocationShape"+      codec `shouldSatisfy` T.isInfixOf "\"local_file\""+      codec `shouldSatisfy` T.isInfixOf "parseOptionalField (pure ShapeArtifactKind.Guide)"+      codec `shouldSatisfy` T.isInfixOf "rejectUnknownFields \"ArtifactInfo\""+      codec `shouldSatisfy` T.isInfixOf "toJSON payload.geometry"+      codec `shouldSatisfy` (not . T.isInfixOf "vendor.geometry.json")+    it "generates shape-only nested types and schema-derived Keiki witnesses" $ do+      spec <- specOf "test/fixtures/consumer-types.keiro"+      let modules = scaffoldModules (defaultContext (spec.context)) spec+          shape = generatedTextEndingIn "Structural/Shape/ArtifactInfo.hs" modules+          facade = generatedTextEndingIn "StructuralProjections.hs" modules+      shape `shouldSatisfy` T.isInfixOf "data ArtifactInfoShape = ArtifactInfo"+      shape `shouldSatisfy` T.isInfixOf "ArtifactKind.ArtifactKindShape"+      mapM_+        (shape `shouldSatisfy`)+        [ T.isInfixOf "description :: !(Maybe Text)",+          T.isInfixOf "tags :: ![Text]",+          T.isInfixOf "labels :: ![Maybe Text]",+          T.isInfixOf "attributes :: !(Map Text Text)"+        ]+      mapM_+        (shape `shouldNotSatisfy`)+        [ T.isInfixOf "description :: !(Maybe (Text))",+          T.isInfixOf "tags :: !([Text])",+          T.isInfixOf "labels :: !([(Maybe (Text))])",+          T.isInfixOf "attributes :: !(Map Text (Text))"+        ]+      shape `shouldSatisfy` (not . T.isInfixOf "KeiroBindings")+      facade `shouldSatisfy` T.isInfixOf "type FieldName"+      facade `shouldSatisfy` T.isInfixOf "= \"/key\""+      facade `shouldSatisfy` T.isInfixOf "fieldShapeId _ = \"example.artifact.ArtifactInfo.v1\""+      facade `shouldSatisfy` T.isInfixOf "type FieldOwner ArtifactInfoKeyProjection = ArtifactInfo"+      facade `shouldSatisfy` T.isInfixOf "bindingToShape KeiroBindings.artifactInfoBinding owner"+      facade `shouldSatisfy` (not . T.isInfixOf "Example.Artifact.Domain.ArtifactInfo")+      facade `shouldSatisfy` T.isInfixOf "artifactInfoKeyWitness"+      facade `shouldNotSatisfy` T.isInfixOf "structuralProjectionC"+    it "suffixes only structural witness names that collide after normalization" $ do+      source <- readTestText "test/fixtures/consumer-types.keiro"+      collisionSpec <-+        parseInlineSpec+          "<projection-name-collision>"+          ( T.replace+              "    key         as \"key\"         : Text                 required"+              ( T.unlines+                  [ "    key         as \"key\"         : Text                 required",+                    "    fooDash     as \"foo-bar\"     : Text                 required",+                    "    fooUnder    as \"foo_bar\"     : Text                 required"+                  ]+              )+              source+          )+      graph <- shouldResolveTypeGraph collisionSpec+      let specs = projectionSpecs graph+          keyWitnesses = [spec.witness | spec <- specs, (.pointer) spec == "/key"]+          collidedWitnesses = [spec.witness | spec <- specs, (.pointer) spec `elem` ["/foo-bar", "/foo_bar"]]+      keyWitnesses `shouldBe` ["artifactInfoKeyWitness"]+      length collidedWitnesses `shouldBe` 2+      Set.size (Set.fromList collidedWitnesses) `shouldBe` 2+      collidedWitnesses `shouldSatisfy` all (T.isPrefixOf "artifactInfoFooBar")+      collidedWitnesses `shouldSatisfy` all (T.isSuffixOf "Witness")+      collidedWitnesses `shouldSatisfy` all ((== 8) . T.length . T.dropEnd (T.length ("Witness" :: T.Text)) . T.drop (T.length ("artifactInfoFooBar" :: T.Text)))+    it "uses only precedence-required parentheses in nested record field types" $ do+      let spec =+            mappedSpec+              [ completeStructural+                  "Nested"+                  ( recordShape+                      [ TMap (TOptional TText),+                        TOptional (TList TText),+                        TOptional (TMap TText)+                      ]+                  )+              ]+          shape = generatedTextEndingIn "Structural/Shape/Nested.hs" (scaffoldStructural (defaultContext (spec.context)) spec)+      mapM_+        (shape `shouldSatisfy`)+        [ T.isInfixOf "field1 :: !(Map Text (Maybe Text))",+          T.isInfixOf "field2 :: !(Maybe [Text])",+          T.isInfixOf "field3 :: !(Maybe (Map Text Text))"+        ]+    it "uses the same precedence rules for strict union payloads" $ do+      let spec =+            mappedSpec+              [ completeStructural+                  "Payload"+                  ( ShapeUnion+                      (TaggedObject "tag" "contents" RejectUnknown)+                      [ WireArm "OptionalPayload" "optional" (Just (TOptional TText)) noLoc,+                        WireArm "ListPayload" "list" (Just (TList (TOptional TText))) noLoc,+                        WireArm "MapPayload" "map" (Just (TMap (TOptional TText))) noLoc+                      ]+                  )+              ]+          shape = generatedTextEndingIn "Structural/Shape/Payload.hs" (scaffoldStructural (defaultContext (spec.context)) spec)+      mapM_+        (shape `shouldSatisfy`)+        [ T.isInfixOf "OptionalPayload !(Maybe Text)",+          T.isInfixOf "ListPayload ![Maybe Text]",+          T.isInfixOf "MapPayload !(Map Text (Maybe Text))"+        ]++  describe "structural manifest" $ do+    it "lists consumer packages and every domain, binding, fixture, and initial module" $ do+      spec <- specOf "test/fixtures/consumer-types.keiro"+      let modules = scaffoldModules (defaultContext (spec.context)) spec+          manifest = renderManifest "consumer-types.keiro" modules spec+      assertGeneratedHaskellContract "consumer-types.keiro" manifest+      mapM_ (\packageName -> manifestDependencies spec `shouldContain` [packageName]) ["artifact-domain", "vendor-geometry"]+      manifest `shouldSatisfy` T.isInfixOf "consumer-packages:\n    artifact-domain\n    vendor-geometry"+      mapM_+        (\moduleName -> manifest `shouldSatisfy` T.isInfixOf moduleName)+        [ "Example.Artifact.Domain",+          "Example.Artifact.KeiroBindings",+          "Vendor.Geometry",+          "Vendor.Geometry.KeiroBindings"+        ]++  describe "structural scaffold record" $ do+    it "round-trips canonical mapping rows and reports binding drift on the next run" $+      withTempDirectory "keiro-dsl-mapping-record" $ \out -> do+        spec <- specOf "test/fixtures/consumer-types.keiro"+        let ctx = defaultContext (spec.context)+        first <- executePlannedScaffold out "consumer-types.keiro" ctx spec+        length first.consumerPlan.mappings `shouldBe` 4+        recordText <- TIO.readFile (out </> recordFileName (spec.context))+        let mappingRows = filter (T.isPrefixOf "mapping ") (T.lines recordText)+            bindingRows = filter (T.isPrefixOf "binding ") (T.lines recordText)+        length mappingRows `shouldBe` 4+        bindingRows `shouldSatisfy` (not . null)+        fmap (.mappings) (parseRecord recordText) `shouldSatisfy` maybe False ((== 4) . length)+        fmap (.bindingObligations) (parseRecord recordText) `shouldSatisfy` maybe False ((== length bindingRows) . length)+        let bumped = spec {mapped = map bumpArtifactBindingVersion ((.mapped) spec)}+        second <- executePlannedScaffold out "consumer-types.keiro" ctx bumped+        (.mappingDrift) second+          `shouldSatisfy` any (\drift -> (.specName) drift == "ArtifactInfo" && (.previous) drift /= (.current) drift)+        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "mapping drift:")+        case mappingRows of+          row : _ -> parseRecord (recordText <> row <> "\n") `shouldBe` Nothing+          [] -> expectationFailure "expected mapping rows"+        case bindingRows of+          row : _ -> parseRecord (recordText <> row <> "\n") `shouldBe` Nothing+          [] -> expectationFailure "expected binding rows"+    it "reports exactly the newly added binding field without rewriting the shared skeleton" $+      withTempDirectory "keiro-dsl-binding-drift" $ \out -> do+        spec <- specOf "test/fixtures/consumer-types.keiro"+        let ctx = defaultContext (spec.context)+        _ <- executePlannedScaffold out "consumer-types.keiro" ctx spec+        let extended = spec {mapped = map addArtifactSummaryField ((.mapped) spec)}+        second <- executePlannedScaffold out "consumer-types.keiro" ctx extended+        (.newHoles) second+          `shouldBe` [ BindingHole+                         { mappedName = "ArtifactInfo",+                           moduleName = "Example.Artifact.KeiroBindings",+                           symbol = "artifactInfoBinding",+                           kind = BindingValue,+                           path = Just "summary",+                           signature = "artifactInfoBinding.summary :: Text"+                         }+                     ]+        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "artifactInfoBinding.summary :: Text")+    it "rejects malformed known mapping JSON while ignoring unrelated future rows" $ do+      spec <- specOf "test/fixtures/consumer-types.keiro"+      withTempDirectory "keiro-dsl-mapping-malformed" $ \out -> do+        report <- executePlannedScaffold out "consumer-types.keiro" (defaultContext (spec.context)) spec+        recordText <- TIO.readFile ((.recordPath) report)+        parseRecord (recordText <> "mapping {not-json}\n") `shouldBe` Nothing+        parseRecord (recordText <> "future-row retained\n") `shouldBe` parseRecord recordText+    it "reports current and legacy semantic impact without globalizing aggregate artifacts" $+      withTempDirectory "keiro-dsl-semantic-impact-report" $ \root -> do+        old <- specOf "test/fixtures/structural-locality.keiro"+        let new = addAlphaPayloadOptionalField old+            legacyNew = mapMappedStructural "AlphaPayload" changeMappedCanonical old+            ctx = defaultContext (old.context)+            currentOut = root </> "current"+            legacyOut = root </> "legacy"+            assertAlphaOnly report = do+              map (.declaration) ((.deltas) (report.semanticImpact))+                `shouldBe` [MappedKey "AlphaPayload"]+              map (.previousConsumers) ((.deltas) (report.semanticImpact))+                `shouldBe` [Set.singleton (AggregateConsumer "Alpha")]+              map (.currentConsumers) ((.deltas) (report.semanticImpact))+                `shouldBe` [Set.singleton (AggregateConsumer "Alpha")]+              let semanticLines = renderSemanticImpactReport (report.semanticImpact)+              semanticLines `shouldSatisfy` any (T.isInfixOf "current aggregate consumers:  Alpha")+              semanticLines `shouldSatisfy` all (not . T.isInfixOf "Beta")+              map (.category) ((.generatedArtifactImpact) report)+                `shouldContain` [ServiceStructuralConformanceArtifact]+              map (.path) ((.generatedArtifactImpact) report)+                `shouldSatisfy` all (not . T.isInfixOf "/Beta/" . T.pack)+        _ <- executePlannedScaffold currentOut "semantic-impact.keiro" ctx old+        current <- executePlannedScaffold currentOut "semantic-impact.keiro" ctx new+        assertAlphaOnly current++        firstLegacy <- executePlannedScaffold legacyOut "semantic-impact.keiro" ctx old+        legacyText <- TIO.readFile ((.recordPath) firstLegacy)+        TIO.writeFile+          ((.recordPath) firstLegacy)+          (T.unlines (filter (not . T.isPrefixOf "semantic-impact ") (T.lines legacyText)))+        legacy <- executePlannedScaffold legacyOut "semantic-impact.keiro" ctx legacyNew+        let legacyLines = renderSemanticImpactReport (legacy.semanticImpact)+        legacyLines `shouldSatisfy` any (T.isInfixOf "baseline: unavailable (legacy ledger)")+        legacyLines `shouldSatisfy` any (T.isInfixOf "current aggregate consumers: Alpha")+        legacyLines `shouldSatisfy` all (not . T.isInfixOf "Beta")+        currentLedger <- TIO.readFile ((.recordPath) legacy)+        (parseRecord currentLedger >>= (.semanticImpact)) `shouldSatisfy` maybe False (const True)+        third <- executePlannedScaffold legacyOut "semantic-impact.keiro" ctx legacyNew+        (.declarations) (third.semanticImpact) `shouldBe` []++  describe "structural import plan" $ do+    it "reports the successful dependency plan in the scaffold report" $+      withTempDirectory "keiro-dsl-dependency-plan" $ \out -> do+        spec <- specOf "test/fixtures/consumer-types.keiro"+        report <- executePlannedScaffold out "consumer-types.keiro" (defaultContext (spec.context)) spec+        renderScaffoldReport report+          `shouldSatisfy` any (T.isInfixOf "dependency plan: consumer packages [artifact-domain, vendor-geometry]")+    it "refuses a binding module inside the generated namespace with the exact cycle" $ do+      spec <- specOf "test/fixtures/consumer-types.keiro"+      let cyclic = spec {mapped = map moveArtifactBindingIntoGenerated ((.mapped) spec)}+      case planTestScaffold (defaultContext (cyclic.context)) cyclic of+        Left refusals -> do+          refusals `shouldSatisfy` any isImportCycle+          renderRefusals refusals `shouldSatisfy` any (T.isInfixOf "Generated.ConsumerDemo.Bindings")+        Right _ -> expectationFailure "expected an import-cycle refusal"+    it "refuses missing mapped register initials but permits command/event-only use" $ do+      missing <- specOf "test/fixtures/mapped-missing-initial.keiro"+      planTestScaffold (defaultContext (missing.context)) missing `shouldSatisfy` isFoldSurfaceRefusal+      spec <- specOf "test/fixtures/consumer-types.keiro"+      let commandOnly = removeMappedRegisterRequirements spec+      planTestScaffold (defaultContext (commandOnly.context)) commandOnly `shouldSatisfy` isRight++  describe "binding explanations" $ do+    it "lists binding, fixture, and use-site-scoped initial obligations deterministically" $ do+      spec <- specOf "test/fixtures/consumer-types.keiro"+      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligations spec)+      length obligations `shouldBe` 7+      obligations+        `shouldSatisfy` any+          ( \obligation ->+              (.kind) obligation == BindingValue+                && (.symbol) obligation == "artifactInfoBinding"+                && (.bindingVersion) obligation == Just "1"+          )+      obligations+        `shouldSatisfy` any+          ( \obligation ->+              (.kind) obligation == InitialValue+                && (.symbol) obligation == "emptyArtifactInfo"+                && any (T.isInfixOf "Catalog register currentArtifact") ((.useSites) obligation)+          )+      let rendered = renderBindingObligations (spec.context) obligations+      rendered `shouldSatisfy` T.isInfixOf "binding obligations for context consumer-demo"+      rendered `shouldSatisfy` T.isInfixOf "artifactInfoBinding :: StructuralBinding Example.Artifact.Domain.ArtifactInfo ArtifactInfoShape"+      rendered `shouldSatisfy` T.isInfixOf "provenance: binding-version \"1\""+    it "states explicitly when a spec has no structural obligations" $ do+      spec <- specOf "test/fixtures/reservation.keiro"+      obligations <- either (\errors -> expectationFailure (show errors) >> pure []) pure (bindingObligations spec)+      renderBindingObligations (spec.context) obligations+        `shouldBe` "no binding obligations for context hospital-capacity"++  describe "exact generic structural bindings" $ do+    forM_+      [ ("renamed-field", "selector mismatch"),+        ("reordered-field", "selector mismatch"),+        ("arity-mismatch", "no exact nominal correspondence"),+        ("incompatible-type", "no exact nominal correspondence")+      ]+      $ \(fixture, diagnostic) ->+        it ("rejects " <> fixture <> " and directs the author to the scaffolded module") $+          expectGenericCompileFailure fixture diagnostic++  describe "structural conformance ownership" $ do+    it "emits declaration laws once at context scope and keeps aggregate-use evidence local" $ do+      service <- checkedServiceOf "test/fixtures/consumer-types.keiro"+      let spec = checkedSpec service+          ctx = defaultContext (spec.context)+          modules = scaffoldServiceModules ctx service+          structural = generatedTextEndingIn "StructuralConformance.hs" modules+          harness = generatedTextEndingIn "Harness.hs" modules+      mapM_+        (\needle -> structural `shouldSatisfy` T.isInfixOf needle)+        [ "binding domain round-trip: example.artifact.ArtifactInfo.v1/",+          "binding shape round-trip: example.artifact.ArtifactInfo.v1/",+          "fixture coverage: example.artifact.ArtifactLocation.v1",+          "canonical identity: example.artifact.ArtifactInfo.v1",+          "projection witness agreement: example.artifact.ArtifactInfo.v1/key",+          "opaque codec round-trip: vendor.geometry.json@3/"+        ]+      mapM_+        (\needle -> harness `shouldSatisfy` T.isInfixOf needle)+        [ "mapped codec round-trip: ArtifactObserved/artifact/",+          "wire policy missing default: example.artifact.ArtifactInfo.v1/description",+          "wire policy explicit null: example.artifact.ArtifactInfo.v1/description",+          "wire policy unknown fields: example.artifact.ArtifactInfo.v1",+          "wire union arm: example.artifact.ArtifactLocation.v1/local_file",+          "forward/replay equality: ObserveArtifact from CatalogEmpty -- ",+          "register currentArtifact"+        ]+      harness `shouldNotSatisfy` T.isInfixOf "binding domain round-trip:"+      harness `shouldNotSatisfy` T.isInfixOf "fixture coverage:"+      harness `shouldNotSatisfy` T.isInfixOf "projection witness agreement:"+      structural `shouldNotSatisfy` T.isInfixOf "mapped codec round-trip:"+      structural `shouldNotSatisfy` T.isInfixOf "wire policy missing default:"+    it "keeps opaque declaration checks at service scope without inventing structural wire policy" $ do+      service <- checkedServiceOf "test/fixtures/consumer-types.keiro"+      let spec = checkedSpec service+          modules = scaffoldServiceModules (defaultContext (spec.context)) service+          structural = generatedTextEndingIn "StructuralConformance.hs" modules+          harness = generatedTextEndingIn "Harness.hs" modules+          codec = generatedTextEndingIn "Codec.hs" modules+      structural `shouldSatisfy` T.isInfixOf "opaque codec round-trip: vendor.geometry.json@3/"+      harness `shouldNotSatisfy` T.isInfixOf "opaque codec round-trip: vendor.geometry.json@3/"+      structural `shouldNotSatisfy` T.isInfixOf "wire policy unknown fields: vendor.geometry.json"+      structural `shouldNotSatisfy` T.isInfixOf "fixture coverage: vendor.geometry"+      codec `shouldNotSatisfy` T.isInfixOf "encodeVendorGeometryShape"+    it "keeps an opaque-only context self-contained" $ do+      service <- checkedServiceOf "test/fixtures/consumer-types.keiro"+      let spec = checkedSpec service+          opaqueOnly =+            checkedServiceWithSpec+              ( spec+                  { mapped = [declaration | declaration@MappedOpaque {} <- (.mapped) spec],+                    nodes = []+                  }+              )+              service+          structural = generatedTextEndingIn "StructuralConformance.hs" (scaffoldServiceModules (defaultContext (spec.context)) opaqueOnly)+      structural `shouldSatisfy` T.isInfixOf "import Keiro.Codec.Structural (FixtureCases (..))"+      structural `shouldSatisfy` T.isInfixOf "opaque codec round-trip: vendor.geometry.json@3/"+      structural `shouldNotSatisfy` T.isInfixOf "bindingDomainRoundTrip"+    it "imports the context structural gate once through the service facade" $ do+      service <- checkedServiceOf "test/fixtures/consumer-types.keiro"+      let ctx = defaultContext ((checkedSpec service).context)+      case serviceHarnessModule ctx service of+        Left duplicates -> expectationFailure ("unexpected duplicate fact keys: " <> show duplicates)+        Right facade -> do+          T.count "import Generated.ConsumerDemo.StructuralConformance qualified as StructuralConformance" ((.text) facade) `shouldBe` 1+          T.count "StructuralConformance.structuralConformanceAssertions" ((.text) facade) `shouldBe` 1+          (.text) facade `shouldSatisfy` T.isInfixOf "\"structural/\" <> fact"+          (.text) facade `shouldNotSatisfy` T.isInfixOf "structuralConformanceAssertions] |"+    it "keeps every Beta artifact byte-identical when an Alpha-only mapped declaration changes" $ do+      workspace <- shouldComposeWorkspace "test/fixtures/structural-locality.keiro-workspace"+      let changedSpec = addAlphaPayloadOptionalField ((.mergedSpec) workspace)+          changedMember member = workspaceMemberWithSpec (addAlphaPayloadOptionalField member.spec) member+          changedWorkspace = workspaceWithMembersAndMergedSpec (map changedMember workspace.members) changedSpec workspace+          ctx = workspaceContext workspace+          plan value = planWorkspaceScaffold "goldens" ctx value+          moduleBytes owner planValue =+            Map.fromList+              [ ((.path) moduleValue, ((.text) moduleValue, (.kind) moduleValue, provenance))+              | (moduleValue, provenance) <- (.modules) planValue,+                ("/" <> owner <> "/") `T.isInfixOf` T.pack ((.path) moduleValue)+              ]+          moduleWith suffix planValue = generatedTextEndingIn suffix (map fst ((.modules) planValue))+      baseline <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (plan workspace)+      changed <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (plan changedWorkspace)+      moduleBytes "Beta" changed `shouldBe` moduleBytes "Beta" baseline+      moduleWith "Alpha/Harness.hs" changed `shouldNotBe` moduleWith "Alpha/Harness.hs" baseline+      moduleWith "StructuralConformance.hs" changed `shouldNotBe` moduleWith "StructuralConformance.hs" baseline+      let alphaHarness = moduleWith "Alpha/Harness.hs" changed+          betaHarness = moduleWith "Beta/Harness.hs" changed+          structural = moduleWith "StructuralConformance.hs" changed+      alphaHarness `shouldSatisfy` T.isInfixOf "mapped codec round-trip: AlphaSubmitted/item/"+      betaHarness `shouldNotSatisfy` T.isInfixOf "AlphaPayload"+      T.count "binding domain round-trip: example.locality.AlphaPayload.v1/" structural `shouldBe` 1+      alphaHarness `shouldNotSatisfy` T.isInfixOf "binding domain round-trip: example.locality.AlphaPayload.v1/"+      betaHarness `shouldNotSatisfy` T.isInfixOf "binding domain round-trip: example.locality.AlphaPayload.v1/"+      structural `shouldSatisfy` T.isInfixOf "fixture coverage: example.locality.UnusedPayload.v1"+    it "refuses a missing fixture before the CLI writes any scaffold output" $+      withTempDirectory "keiro-dsl-structural-no-write" $ \out -> do+        baselineTree <- treeSnapshot out+        (exitCode, _, standardError) <- runKeiroDsl ["scaffold", "test/fixtures/mapped-missing-fixture.keiro", "--out", out]+        exitCode `shouldSatisfy` (/= ExitSuccess)+        standardError `shouldContain` "missing fixtures ingredient"+        treeSnapshot out `shouldReturn` baselineTree++  describe "semantic locality qualification" $ do+    it "pins the exact A-only generated delta and semantic report" $+      withSemanticLocalityFixture "keiro-dsl-locality-a-only" id 0 $ \_ out workspace -> do+        baselinePlan <- shouldPlanWorkspaceSpec workspace+        let changedWorkspace = mapWorkspaceSpec addAlphaPayloadOptionalField workspace+        changedPlan <- shouldPlanWorkspaceSpec changedWorkspace+        let baselineModules = map fst ((.modules) baselinePlan)+            changedModules = map fst ((.modules) changedPlan)+            delta = generatedTreeDelta baselineModules changedModules+            expectedPaths =+              Set.fromList+                [ "Generated/SemanticLocality/Alpha/Codec.hs",+                  "Generated/SemanticLocality/Alpha/Harness.hs",+                  "Generated/SemanticLocality/Structural/Shape/AlphaPayload.hs",+                  "Generated/SemanticLocality/StructuralConformance.hs"+                ]+            allowedRoles =+              Set.fromList+                [ moduleRole generatedModule+                | generatedModule <- changedModules,+                  (.path) generatedModule `Set.member` expectedPaths+                ]+            impact = CheckedDiff.mappedSemanticImpact ((.mergedSpec) workspace) ((.mergedSpec) changedWorkspace)+            renderedImpact = T.unlines (renderSemanticImpact impact)+            encodedReport = LazyText.toStrict (LazyTextEncoding.decodeUtf8 (Aeson.encode (diffReportWithSemanticImpact defaultGate (diffSpecs ((.mergedSpec) workspace) ((.mergedSpec) changedWorkspace)) impact)))+        (.changedPaths) delta `shouldBe` expectedPaths+        (.addedPaths) delta `shouldBe` Set.empty+        (.removedPaths) delta `shouldBe` Set.empty+        assertAllowedGeneratedDelta allowedRoles baselineModules changedModules delta+        map (.declaration) impact `shouldBe` [MappedKey "AlphaPayload"]+        map (.previousConsumers) impact `shouldBe` [Set.singleton (AggregateConsumer "Alpha")]+        map (.currentConsumers) impact `shouldBe` [Set.singleton (AggregateConsumer "Alpha")]+        renderedImpact `shouldSatisfy` T.isInfixOf "previous aggregate consumers: Alpha"+        renderedImpact `shouldSatisfy` T.isInfixOf "service-conformance: impacted"+        renderedImpact `shouldSatisfy` (not . T.isInfixOf "Beta")+        encodedReport `shouldSatisfy` T.isInfixOf "\"semanticImpact\""+        encodedReport `shouldSatisfy` T.isInfixOf "\"currentConsumers\":[\"Alpha\"]"+        encodedReport `shouldSatisfy` (not . T.isInfixOf "Beta")++        _ <- executePlannedWorkspaceScaffold out workspace+        report <- executePlannedWorkspaceScaffold out changedWorkspace+        (.declarations) (report.semanticImpact) `shouldBe` [MappedKey "AlphaPayload"]+        map (.path) ((.generatedArtifactImpact) report) `shouldBe` Set.toAscList expectedPaths+        map (.category) ((.generatedArtifactImpact) report)+          `shouldSatisfy` \categories ->+            AggregateGeneratedArtifact `elem` categories+              && ServiceStructuralConformanceArtifact `elem` categories+        map (.category) ((.generatedArtifactImpact) report)+          `shouldNotContain` [BehaviorSourceMapArtifact]+        ledger <- TIO.readFile ((.recordPath) report)+        case parseWorkspaceRecord ledger of+          Just record -> record.semanticImpact `shouldSatisfy` (/= Nothing)+          Nothing -> expectationFailure "semantic-locality workspace ledger did not parse"++    it "keeps the A-only delta constant with ten unrelated aggregates" $ do+      let deltaFor count =+            withSemanticLocalityFixture ("keiro-dsl-locality-scale-" <> show count) id count $ \_ _ workspace -> do+              baseline <- shouldPlanWorkspaceSpec workspace+              changed <- shouldPlanWorkspaceSpec (mapWorkspaceSpec addAlphaPayloadOptionalField workspace)+              pure (generatedTreeDelta (map fst ((.modules) baseline)) (map fst ((.modules) changed)))+      twoAggregateDelta <- deltaFor 0+      twelveAggregateDelta <- deltaFor 10+      twelveAggregateDelta `shouldBe` twoAggregateDelta++    it "keeps nested and fixture-symbol changes local while shared and unused laws remain service-owned" $+      withSemanticLocalityFixture "keiro-dsl-locality-closure" id 0 $ \_ _ workspace -> do+        baseline <- shouldPlanWorkspaceSpec workspace+        nested <- shouldPlanWorkspaceSpec (mapWorkspaceSpec addNestedPayloadOptionalField workspace)+        fixtureChanged <- shouldPlanWorkspaceSpec (mapWorkspaceSpec changeAlphaPayloadFixtureSymbol workspace)+        let baselineModules = map fst ((.modules) baseline)+            nestedModules = map fst ((.modules) nested)+            fixtureModules = map fst ((.modules) fixtureChanged)+            nestedDelta = generatedTreeDelta baselineModules nestedModules+            fixtureDelta = generatedTreeDelta baselineModules fixtureModules+            betaPaths = Set.fromList [(.path) value | value <- baselineModules, "/Beta/" `T.isInfixOf` T.pack ((.path) value)]+            structural = generatedTextEndingIn "StructuralConformance.hs" baselineModules+            alphaHarness = generatedTextEndingIn "Alpha/Harness.hs" baselineModules+            betaHarness = generatedTextEndingIn "Beta/Harness.hs" baselineModules+            snapshot = semanticImpactSnapshotForSpec ((.mergedSpec) workspace)+        (.changedPaths) nestedDelta `shouldSatisfy` Set.null . Set.intersection betaPaths+        (.changedPaths) fixtureDelta `shouldSatisfy` Set.null . Set.intersection betaPaths+        map (.declaration) (CheckedDiff.mappedSemanticImpact ((.mergedSpec) workspace) (addNestedPayloadOptionalField ((.mergedSpec) workspace)))+          `shouldBe` [MappedKey "AlphaPayload", MappedKey "NestedPayload"]+        mappedDeclarationConsumers (semanticImpactForSpec ((.mergedSpec) workspace)) (MappedKey "SharedPayload")+          `shouldBe` [AggregateConsumer "Alpha", AggregateConsumer "Beta"]+        mappedDeclarationConsumers (semanticImpactForSpec ((.mergedSpec) workspace)) (MappedKey "UnusedPayload")+          `shouldBe` []+        (.serviceInventory) snapshot `shouldSatisfy` Set.member (MappedKey "UnusedPayload")+        T.count "fixture coverage: example.semantic-locality.SharedPayload.v1" structural `shouldBe` 1+        T.count "fixture coverage: example.semantic-locality.UnusedPayload.v1" structural `shouldBe` 1+        alphaHarness `shouldSatisfy` T.isInfixOf "SharedPayload"+        betaHarness `shouldSatisfy` T.isInfixOf "SharedPayload"+        alphaHarness `shouldNotSatisfy` T.isInfixOf "fixture coverage:"+        betaHarness `shouldNotSatisfy` T.isInfixOf "fixture coverage:"++    it "isolates comments, blank lines, and an unrelated rule to BehaviorSourceMap" $ do+      let mutations =+            [ ("comment", ("# source-only movement\n" <>)),+              ("blank-line", ("\n" <>)),+              ( "unrelated-rule",+                T.replace+                  "aggregate Alpha\n"+                  "rule unusedIsUnused : UnusedPayload -> Bool\n  ex Unused => true\n\naggregate Alpha\n"+              )+            ]+      forM_ mutations $ \(variantName, mutateSource) ->+        withSemanticLocalityFixture ("keiro-dsl-locality-source-" <> variantName) id 0 $ \root out workspace -> do+          _ <- executePlannedWorkspaceScaffold out workspace+          treeBefore <- treeSnapshot out+          let path = root </> "domain/alpha.keiro"+          original <- TIO.readFile path+          TIO.writeFile path (mutateSource original)+          moved <- loadTempWorkspace root+          report <- executePlannedWorkspaceScaffold out moved+          let overwritten = [value.path | (value, _, Overwritten) <- (.dispositions) report]+              sourceMapPath path = T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack path)+          overwritten `shouldSatisfy` \case+            [path] -> sourceMapPath path+            _ -> False+          (.declarations) (report.semanticImpact) `shouldBe` []+          map (.category) ((.generatedArtifactImpact) report) `shouldBe` [BehaviorSourceMapArtifact]+          treeAfter <- treeSnapshot out+          let treeDelta = generatedTreeDeltaFromSnapshot treeBefore treeAfter+              ledgerPath path = T.isPrefixOf "keiro-dsl-ledger.workspace." (T.pack path)+          (.changedPaths) treeDelta `shouldSatisfy` \paths ->+            Set.size paths == 2+              && any sourceMapPath paths+              && any ledgerPath paths+          filter (\(path, _) -> not (sourceMapPath path || ledgerPath path)) treeAfter+            `shouldBe` filter (\(path, _) -> not (sourceMapPath path || ledgerPath path)) treeBefore++    it "keeps complete scaffold bytes deterministic under member reordering" $+      withSemanticLocalityFixture "keiro-dsl-locality-order-a" id 0 $ \_ outA workspaceA ->+        withSemanticLocalityFixture "keiro-dsl-locality-order-b" reverse 0 $ \_ outB workspaceB -> do+          _ <- executePlannedWorkspaceScaffold outA workspaceA+          _ <- executePlannedWorkspaceScaffold outB workspaceB+          expected <- treeSnapshot outA+          treeSnapshot outB `shouldReturn` expected++  describe "generated Haskell language contract" $ do+    it "limits every representative generated module to the closed local extension set" $ do+      let allowed =+            Set.fromList+              [ "BlockArguments",+                "DeriveAnyClass",+                "DuplicateRecordFields",+                "OverloadedLabels",+                "OverloadedRecordDot",+                "QualifiedDo",+                "TemplateHaskell",+                "TypeFamilies"+              ]+          fixtures =+            [ "test/fixtures/aggregate-scalar-expressions-v2.keiro",+              "test/fixtures/nominal-scalars.keiro",+              "test/fixtures/structural-conformance.keiro",+              "test/fixtures/reservation.keiro",+              "test/fixtures/contract-v4.keiro",+              "test/fixtures/intake.keiro",+              "test/fixtures/reservation-work.keiro",+              "test/fixtures/readmodel-runtime.keiro"+            ]+      forM_ fixtures $ \fixture -> do+        modules <- scaffoldFixture fixture+        forM_ [generatedModule | generatedModule <- modules, (.kind) generatedModule == Generated] $ \generatedModule -> do+          let actual = Set.fromList (generatedLocalExtensions generatedModule)+          unless (actual `Set.isSubsetOf` allowed) $+            expectationFailure (fixture <> ":" <> (.path) generatedModule <> ": disallowed local extensions " <> show (Set.toList (actual `Set.difference` allowed)))++    it "retains specialized syntax extensions and removes GHC2024-covered pragmas" $ do+      scalar <- scaffoldFixture "test/fixtures/aggregate-scalar-expressions-v2.keiro"+      structural <- scaffoldFixture "test/fixtures/structural-conformance.keiro"+      reservation <- scaffoldFixture "test/fixtures/reservation.keiro"+      contract <- scaffoldFixture "test/fixtures/contract-v4.keiro"+      intake <- scaffoldFixture "test/fixtures/intake.keiro"+      queue <- scaffoldFixture "test/fixtures/reservation-work.keiro"+      readModel <- scaffoldFixture "test/fixtures/readmodel-runtime.keiro"+      generatedExtensionsEndingIn "ScalarAccount/Domain.hs" scalar+        `shouldBe` ["DeriveAnyClass", "TemplateHaskell"]+      generatedExtensionsEndingIn "ScalarAccount/Transducer.hs" scalar+        `shouldBe` ["BlockArguments", "OverloadedLabels", "QualifiedDo"]+      generatedExtensionsEndingIn "Nominals.hs" scalar `shouldContain` ["DeriveAnyClass", "TypeFamilies"]+      generatedExtensionsEndingIn "Nominals/Internal.hs" scalar `shouldBe` []+      generatedExtensionsEndingIn "StructuralProjections.hs" structural `shouldBe` ["TypeFamilies"]+      let structuralShapeExtensions =+            [ generatedLocalExtensions generatedModule+            | generatedModule <- structural,+              "/Structural/Shape/" `T.isInfixOf` T.pack ((.path) generatedModule)+            ]+      structuralShapeExtensions `shouldSatisfy` all null+      generatedExtensionsEndingIn "Projection.hs" reservation `shouldBe` []+      generatedExtensionsEndingIn "ReplayAudit.hs" reservation `shouldBe` []+      generatedExtensionsEndingIn "Contract.hs" contract `shouldBe` []+      generatedExtensionsEndingIn "Inbox.hs" intake `shouldBe` []+      generatedExtensionsEndingIn "Queue.hs" queue `shouldBe` []+      generatedExtensionsEndingIn "ReadModel.hs" readModel `shouldBe` []++    it "conditions label and derivation extensions on emitted syntax while record defaults stay manifest-owned" $ do+      mappedGuardSource <- readTestText "test/fixtures/mapped-guard.keiro"+      mappedGuardParsed <- case parseSource "mapped-guard-no-expression.keiro" (T.replace "guard current == current ; " "" mappedGuardSource) of+        Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+        Right parsed -> pure parsed+      let mappedGuardService = checkedSource mappedGuardParsed+          mappedGuard = scaffoldServiceModules (defaultContext ((checkedSpec mappedGuardService).context)) mappedGuardService+      registerFree <- scaffoldFixture "test/fixtures/order.keiro"+      readModels <- scaffoldFixture "test/fixtures/readmodel.keiro"+      snapshot <- scaffoldFixture "test/fixtures/reservation-snapshot.keiro"+      ordinary <- scaffoldFixture "test/fixtures/reservation.keiro"+      generatedExtensionsEndingIn "Holder/Domain.hs" mappedGuard `shouldBe` ["TemplateHaskell"]+      generatedExtensionsEndingIn "Holder/Codec.hs" mappedGuard `shouldBe` []+      generatedExtensionsEndingIn "Holder/Transducer.hs" mappedGuard+        `shouldBe` ["BlockArguments", "QualifiedDo"]+      generatedExtensionsEndingIn "Holder/Harness.hs" mappedGuard `shouldBe` ["OverloadedLabels"]+      generatedExtensionsEndingIn "Order/Harness.hs" registerFree `shouldBe` []+      generatedExtensionsEndingIn "TransferDecisions/ReadModel.hs" readModels `shouldBe` []+      generatedExtensionsEndingIn "Subscriptions/ReadModel.hs" readModels `shouldBe` []+      generatedExtensionsEndingIn "Reservation/Domain.hs" snapshot `shouldContain` ["DeriveAnyClass"]+      generatedExtensionsEndingIn "Reservation/Domain.hs" ordinary `shouldNotContain` ["DeriveAnyClass"]++      disjoint <-+        parseInlineSpec "<disjoint-contract>" $+          T.unlines+            [ "language keiro-dsl 4",+              "context language-contract",+              "contract disjoint {",+              "  schemaVersion 1",+              "  discriminator kind",+              "  topic events \"events\"",+              "  event First on events { first: text }",+              "  event Second on events { second: text }",+              "}"+            ]+      emptyPayload <-+        parseInlineSpec "<empty-contract>" $+          T.unlines+            [ "language keiro-dsl 4",+              "context language-contract",+              "contract empty {",+              "  schemaVersion 1",+              "  discriminator kind",+              "  topic events \"events\"",+              "  event Empty on events { }",+              "}"+            ]+      let contractExtensions spec =+            generatedExtensionsEndingIn+              "Contract.hs"+              [ generatedModule+              | contractNode <- [contractNode | NContract contractNode <- (.nodes) spec],+                generatedModule <- scaffoldContract (defaultContext (spec.context)) contractNode+              ]+      contractExtensions disjoint `shouldBe` []+      contractExtensions emptyPayload `shouldBe` []++  describe "manifest (M2)" $ do+    it "lists exactly the modules the scaffolder produced" $ do+      mods <- scaffoldFixture "test/fixtures/reservation.keiro"+      service <- checkedServiceOf "test/fixtures/reservation.keiro"+      let manifest = renderManifestForService "reservation.keiro" mods service+          expectedNames = sort (map (moduleNameOf . (.path)) mods)+      assertGeneratedHaskellContract "reservation.keiro" manifest+      -- every produced module name appears in the manifest…+      mapM_ (\m -> (m `T.isInfixOf` manifest) `shouldBe` True) expectedNames+      -- …and the module list is exactly the scaffolder's output set.+      expectedNames+        `shouldBe` sort+          [ "Generated.HospitalCapacity.Reservation.Codec",+            "Generated.HospitalCapacity.Reservation.BehaviorContract",+            "Generated.HospitalCapacity.Reservation.Domain",+            "Generated.HospitalCapacity.Reservation.EventStream",+            "Generated.HospitalCapacity.Reservation.Harness",+            "Generated.HospitalCapacity.Reservation.Projection",+            "Generated.HospitalCapacity.Reservation.Transducer",+            "Generated.HospitalCapacity.Nominals",+            "Generated.HospitalCapacity.Nominals.Internal",+            "Generated.HospitalCapacity.ReplayAudit",+            "HospitalCapacity.Reservation.BehaviorHoles",+            "HospitalCapacity.Reservation.Holes"+          ]+    it "derives the dependency set from the node kinds present (aggregate)" $ do+      service <- checkedServiceOf "test/fixtures/reservation.keiro"+      manifestDependenciesForService service `shouldBe` ["aeson", "base", "keiki", "keiro", "text"]+    it "derives the process dependency set, including worker-policy runtime imports" $ do+      service <- checkedServiceOf "test/fixtures/hospital-surge.keiro"+      let dependencies = manifestDependenciesForService service+      mapM_ (\dependency -> dependencies `shouldContain` [dependency]) ["time", "uuid", "shibuya-core", "keiki", "keiro"]+    it "uses the registered shibuya-core package name for router scaffolds" $ do+      service <- checkedServiceOf "test/fixtures/incident-paging/incident-paging.keiro"+      let dependencies = manifestDependenciesForService service+      mapM_ (\dependency -> dependencies `shouldContain` [dependency]) ["effectful-core", "keiro", "shibuya-core"]+      dependencies `shouldNotContain` ["shibuya"]++  describe "service conformance facade (plan 188 M2)" $ do+    it "normalizes aggregate and read-model checks behind one base-only API" $ do+      service <- checkedServiceOf "test/fixtures/transfer-routing.keiro"+      let ctx = defaultContext ((checkedSpec service).context)+      case serviceHarnessModule ctx service of+        Left duplicates -> expectationFailure ("unexpected duplicate fact keys: " <> show duplicates)+        Right facade -> do+          committed <- readTestText ("test/conformance-newsurface/" <> (.path) facade)+          normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) facade)+          moduleNameOf ((.path) facade) `shouldBe` "Generated.TransferRouting.Conformance"+          (.text) facade `shouldSatisfy` T.isInfixOf ".harnessAssertions"+          (.text) facade `shouldSatisfy` T.isInfixOf ".readModelFactResults"+          (.text) facade `shouldSatisfy` T.isInfixOf "aggregate/Hospital/"+          (.text) facade `shouldSatisfy` T.isInfixOf "readmodel/hospital_load/"+          (.text) facade `shouldSatisfy` T.isInfixOf "qualified as Hospital"+          (.text) facade `shouldSatisfy` T.isInfixOf "qualified as HospitalLoad"+          (.text) facade `shouldNotSatisfy` T.isInfixOf "qualified as Harness"+          (.text) facade `shouldNotSatisfy` T.isInfixOf "TransferRouting.Hospital.Holes"+    it "projects process, router, and workflow facts with qualified stable keys" $ do+      processService <- checkedServiceOf "test/fixtures/hospital-surge.keiro"+      routerService <- checkedServiceOf "test/fixtures/incident-paging/incident-paging.keiro"+      workflowService <- checkedServiceOf "test/fixtures/workflow-evolution.keiro"+      let select predicate = filter predicate . (.nodes) . checkedSpec+          factNodes =+            select (\case NProcess {} -> True; _ -> False) processService+              <> select (\case NRouter {} -> True; _ -> False) routerService+              <> select (\case NWorkflow {} -> True; _ -> False) workflowService+          baseSpec = checkedSpec processService+          service = checkedServiceWithSpec (specWithNodes factNodes baseSpec) processService+          ctx = defaultContext (baseSpec.context)+      forM_+        [ "process/HospitalSurge/maxAttempts",+          "router/PagingRouter/dispatchCommand",+          "workflow/HospitalTransferReservation/body"+        ]+        (\key -> serviceConformanceFactKeys service `shouldSatisfy` elem key)+      case serviceHarnessModule ctx service of+        Left duplicates -> expectationFailure ("unexpected duplicate fact keys: " <> show duplicates)+        Right facade -> do+          (.text) facade `shouldSatisfy` T.isInfixOf ".processHarnessValues"+          (.text) facade `shouldSatisfy` T.isInfixOf ".routerHarnessValues"+          (.text) facade `shouldSatisfy` T.isInfixOf ".workflowFactValues"+    it "uses the shared context-level placement policy" $ do+      service <- checkedServiceOf "test/fixtures/contract-v4.keiro"+      let ctx = Context {name = "modules", moduleRoot = "Mori", placement = CollocatedLeaf}+      serviceConformanceModuleName ctx `shouldBe` "Mori.Modules.Generated.Conformance"+      case serviceHarnessModule ctx service of+        Left duplicates -> expectationFailure ("unexpected duplicate fact keys: " <> show duplicates)+        Right facade -> do+          (.text) facade `shouldSatisfy` T.isInfixOf "runServiceConformanceChecks = pure []"+          (.text) facade `shouldSatisfy` T.isInfixOf "serviceConformanceFacts = []"+    it "adds one facade only to configured single-file plans and exposes only it" $ do+      service <- checkedServiceOf "test/fixtures/reservation.keiro"+      let ctx = defaultContext ((checkedSpec service).context)+          runtimePackage = RuntimePackageName "reservation-runtime"+      unconfigured <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffold ctx service)+      configured <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffoldWithRuntimePackage (Just runtimePackage) ctx service)+      let facadeName = serviceConformanceModuleName ctx+          facades = [moduleValue | moduleValue <- configured, moduleNameOf ((.path) moduleValue) == facadeName]+          manifest = renderManifestForServiceWithFacade (Just facadeName) "reservation.keiro" configured service+      length configured `shouldBe` length unconfigured + 1+      length facades `shouldBe` 1+      manifest `shouldSatisfy` T.isInfixOf ("exposed-modules:\n    " <> facadeName)+      T.count facadeName manifest `shouldBe` 1+    it "emits one context-level facade for a multi-member workspace regardless of member order" $ do+      canonical <- shouldComposeWorkspace canonicalWorkspacePath+      reordered <- shouldComposeWorkspace "test/fixtures/workspace/service-reordered.keiro-workspace"+      let runtimePackage = Just (RuntimePackageName "demo-runtime")+          plan workspace =+            planWorkspaceScaffoldWithRuntimePackageAndGoldens [] runtimePackage "goldens" (workspaceContext workspace) workspace+          facades workspacePlan =+            [ ((.text) moduleValue, provenance)+            | (moduleValue, provenance) <- (.modules) workspacePlan,+              ".Conformance" `T.isSuffixOf` moduleNameOf ((.path) moduleValue)+            ]+      canonicalPlan <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (plan canonical)+      reorderedPlan <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (plan reordered)+      facades canonicalPlan `shouldBe` facades reorderedPlan+      map snd (facades canonicalPlan) `shouldBe` [ContextLevel]+    it "refuses duplicate normalized fact keys before planning writes" $ do+      service <- checkedServiceOf "test/fixtures/hospital-surge.keiro"+      let spec = checkedSpec service+          processes = [node | node@NProcess {} <- (.nodes) spec]+          duplicated = checkedServiceWithSpec (specWithNodes (processes <> processes) spec) service+      serviceHarnessModule (defaultContext (spec.context)) duplicated `shouldSatisfy` isLeft++  describe "runnable service conformance package (plan 188 M3)" $ do+    it "uses readable ordinary names and collision-safe punctuation encoding" $ do+      cabaliseConformanceService "mori" `shouldBe` "mori"+      cabaliseConformanceService "mori_core" `shouldNotBe` cabaliseConformanceService "mori-core"+      cabaliseConformanceService "Mori" `shouldNotBe` cabaliseConformanceService "mori"+      conformancePackageDirectory (WorkspaceConformanceService "mori") `shouldBe` "keiro-dsl-conformance.workspace.mori"+      conformancePackageDirectory (StandaloneConformanceService "mori") `shouldBe` "keiro-dsl-conformance.mori"+    it "plans one base-only package and round-trips its complete generated record" $ do+      service <- checkedServiceOf "test/fixtures/hospital-surge.keiro"+      let runtimePackage = RuntimePackageName "hospital-runtime"+          facade = "Generated.HospitalSurge.Conformance"+      plan <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planConformancePackage (StandaloneConformanceService "hospital-surge") runtimePackage facade service)+      (.packageName) plan `shouldBe` "keiro-hospital-surge-conformance"+      length [file | file <- (.files) plan, takeExtension ((.path) file) == ".cabal"] `shouldBe` 1+      cabalFile <- case [file | file <- (.files) plan, takeExtension ((.path) file) == ".cabal"] of+        [file] -> pure file+        files -> expectationFailure ("expected one Cabal file, got " <> show (map (.path) files)) >> fail "unreachable"+      let cabalText = (.text) cabalFile+      cabalText `shouldSatisfy` T.isInfixOf "base >=4.18 && <5"+      T.lines cabalText `shouldSatisfy` (\lines' -> case lines' of first : _ -> first == "cabal-version: 3.0"; [] -> False)+      cabalText `shouldSatisfy` T.isInfixOf "hospital-runtime"+      cabalText `shouldSatisfy` T.isInfixOf "ghc-options: -Wall"+      cabalText `shouldNotSatisfy` T.isInfixOf "    , keiro-dsl\n"+      recordFile <- case [file | file <- (.files) plan, (.path) file == conformanceRecordFileName] of+        [file] -> pure file+        files -> expectationFailure ("expected one package record, got " <> show (map (.path) files)) >> fail "unreachable"+      let recordText = (.text) recordFile+      parseConformancePackageRecord recordText+        `shouldBe` Just+          ConformancePackageRecord+            { schema = 1,+              serviceKey = (.serviceKey) plan,+              runtimePackage = runtimePackage,+              facadeModule = facade,+              files = [((.kind) file, (.path) file) | file <- (.files) plan]+            }+    it "tolerates future rows and JSON keys while round-tripping awkward safe paths" $ do+      let recordText =+            T.unlines+              [ "keiro-dsl conformance ledger v1",+                "service-key standalone hospital-surge",+                "runtime-package hospital-runtime",+                "facade-module Generated.HospitalSurge.Conformance",+                "file {\"kind\":\"generated\",\"path\":\"generated/file with space.hs\",\"future-key\":true}",+                "future-row {\"value\":1}"+              ]+          expected =+            ConformancePackageRecord+              { schema = 1,+                serviceKey = StandaloneConformanceService "hospital-surge",+                runtimePackage = RuntimePackageName "hospital-runtime",+                facadeModule = "Generated.HospitalSurge.Conformance",+                files = [(Generated, "generated/file with space.hs")]+              }+      parseConformancePackageRecord recordText `shouldBe` Just expected+      parseConformancePackageRecord (renderConformancePackageRecord expected) `shouldBe` Just expected+      parseConformancePackageRecord (T.replace "generated/file with space.hs" "../escape.hs" recordText)+        `shouldBe` Nothing+      parseConformancePackageRecord (T.replace "future-row {\"value\":1}" "file {\"kind\":\"generated\",\"path\":\"GENERATED/FILE WITH SPACE.HS\"}" recordText)+        `shouldBe` Nothing+    it "compares unique facts by key and distinguishes mismatch, missing, and unexpected" $ do+      compareConformanceFacts [("a", "1"), ("b", "2"), ("d", "4")] [("c", "3"), ("a", "1"), ("b", "9")]+        `shouldBe` Right+          [ ConformanceFactMatch "a" "1",+            ConformanceFactMismatch "b" "2" "9",+            ConformanceFactUnexpected "c" "3",+            ConformanceFactMissing "d" "4"+          ]+      compareConformanceFacts [("a", "1"), ("a", "2")] []+        `shouldBe` Left [DuplicateFactKey ExpectedFact "a"]+    it "creates once, reports generated files unchanged, and preserves accepted expectations" $ do+      withTempDirectory "keiro-dsl-conformance-package" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/hospital-surge.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            runtimePackage = RuntimePackageName "hospital-runtime"+        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffoldWithRuntimePackage (Just runtimePackage) ctx service)+        first <- executeServiceScaffoldWithRuntimePackage (Just runtimePackage) out False "hospital-surge.keiro" ((.sourceLanguage) parsed) ctx service modules+        firstReport <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure first+        firstPackage <- maybe (expectationFailure "expected conformance package report" >> fail "unreachable") pure ((.conformancePackage) firstReport)+        let packageRoot = out </> conformancePackageDirectory (StandaloneConformanceService ((.name) ctx))+            expectationsPath = packageRoot </> "src/KeiroConformance/Expectations.hs"+            accepted = "module KeiroConformance.Expectations where\n-- accepted by the application\n"+        map snd ((.dispositions) firstPackage) `shouldContain` [ConformanceCreated]+        TIO.writeFile expectationsPath accepted+        second <- executeServiceScaffoldWithRuntimePackage (Just runtimePackage) out True "hospital-surge.keiro" ((.sourceLanguage) parsed) ctx service modules+        secondReport <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure second+        secondPackage <- maybe (expectationFailure "expected conformance package report" >> fail "unreachable") pure ((.conformancePackage) secondReport)+        TIO.readFile expectationsPath `shouldReturn` accepted+        [ disposition+          | (file, disposition) <- (.dispositions) secondPackage,+            (.kind) file == Generated+          ]+          `shouldSatisfy` all (== ConformanceUnchanged)+        [ disposition+          | (file, disposition) <- (.dispositions) secondPackage,+            (.kind) file == HoleStub+          ]+          `shouldBe` [ConformanceSkipped]+    -- Migration used to be planned only when the run also planned a conformance+    -- package, so a spec that stopped generating one left its legacy record+    -- behind — and unreadable, since the current reader has no legacy parser.+    -- See ExecPlan 199.+    it "migrates an orphaned legacy conformance record even with no package planned" $+      withTempDirectory "keiro-dsl-orphan-conformance-ledger" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/hospital-surge.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            orphanDirectory = out </> "keiro-dsl-conformance.standalone.retired-service"+            orphanPath = orphanDirectory </> legacyConformanceRecordFileName+            -- No --runtime-package, so this run plans no conformance package at+            -- all: the record below belongs to a package that no longer exists.+            run apply = do+              modules <-+                either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure $+                  planTestServiceScaffoldWithRuntimePackage Nothing ctx service+              executeServiceScaffoldWithRuntimePackageAndNameMigrations+                Nothing+                apply+                out+                False+                "hospital-surge.keiro"+                ((.sourceLanguage) parsed)+                ctx+                service+                modules+        -- Build the orphan from a record the current writer produced, so the+        -- test exercises the discovery change and not a hand-typed format.+        withTempDirectory "keiro-dsl-orphan-source" $ \source -> do+          let sourceRuntime = RuntimePackageName "retired-runtime"+              sourcePackageRoot = source </> conformancePackageDirectory (StandaloneConformanceService ((.name) ctx))+          sourceModules <-+            either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure $+              planTestServiceScaffoldWithRuntimePackage (Just sourceRuntime) ctx service+          _ <-+            executeServiceScaffoldWithRuntimePackageAndNameMigrations+              (Just sourceRuntime)+              False+              source+              False+              "hospital-surge.keiro"+              ((.sourceLanguage) parsed)+              ctx+              service+              sourceModules+              >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+          ledger <- TIO.readFile (sourcePackageRoot </> conformanceLedgerFileName)+          record <-+            maybe (expectationFailure "conformance ledger did not parse" >> fail "unreachable") pure $+              parseConformancePackageRecord ledger+          createDirectoryIfMissing True orphanDirectory+          TIO.writeFile+            orphanPath+            ( T.unlines $+                [line | line <- T.lines ledger, isGeneratedBannerLine line]+                  <> [ "schema 1",+                       "service-key standalone " <> (.name) ctx,+                       "runtime-package " <> (.unRuntimePackageName) ((.runtimePackage) record),+                       "facade-module " <> (.facadeModule) record+                     ]+                  <> [ "file "+                         <> (case fileKind of Generated -> "generated"; HoleStub -> "create-once")+                         <> " "+                         <> T.pack path+                     | (fileKind, path) <- (.files) record+                     ]+            )+        refused <- run False+        refused `shouldSatisfy` \case+          Left [SidecarMigrationRequired [move]] ->+            (.moveDisposition) move == ConvertLegacyConformanceLedger+          _ -> False++        applied <- run True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        map (.moveDisposition) ((.sidecarMoves) applied) `shouldBe` [ConvertLegacyConformanceLedger]+        doesFileExist orphanPath `shouldReturn` False+        doesFileExist (orphanDirectory </> conformanceLedgerFileName) `shouldReturn` True++    it "converts a legacy conformance record losslessly and keeps service-key mismatch refusal" $+      withTempDirectory "keiro-dsl-conformance-ledger-migration" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/hospital-surge.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            runtimePackage = RuntimePackageName "hospital-runtime"+            packageRoot = out </> conformancePackageDirectory (StandaloneConformanceService ((.name) ctx))+            currentPath = packageRoot </> conformanceLedgerFileName+            legacyPath = packageRoot </> legacyConformanceRecordFileName+            backupPath = out </> ".keiro-dsl-name-migrations/sidecar-v1" </> conformancePackageDirectory (StandaloneConformanceService ((.name) ctx)) </> legacyConformanceRecordFileName+        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffoldWithRuntimePackage (Just runtimePackage) ctx service)+        let run apply =+              executeServiceScaffoldWithRuntimePackageAndNameMigrations+                (Just runtimePackage)+                apply+                out+                False+                "hospital-surge.keiro"+                ((.sourceLanguage) parsed)+                ctx+                service+                modules+            renderLegacyKey (WorkspaceConformanceService value) = "workspace " <> value+            renderLegacyKey (StandaloneConformanceService value) = "standalone " <> value+            renderLegacyKind Generated = "generated"+            renderLegacyKind HoleStub = "create-once"+        _ <- run False >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        currentContents <- TIO.readFile currentPath+        record <- maybe (expectationFailure "fresh conformance ledger did not parse" >> fail "unreachable") pure (parseConformancePackageRecord currentContents)+        let legacyRecord =+              conformanceRecordWithFiles+                [ (fileKind, if path == conformanceLedgerFileName then legacyConformanceRecordFileName else path)+                | (fileKind, path) <- record.files+                ]+                record+            legacyContents =+              T.unlines $+                [line | line <- T.lines currentContents, isGeneratedBannerLine line]+                  <> [ "schema 1",+                       "service-key " <> renderLegacyKey ((.serviceKey) legacyRecord),+                       "runtime-package " <> (.unRuntimePackageName) legacyRecord.runtimePackage,+                       "facade-module " <> (.facadeModule) legacyRecord+                     ]+                  <> ["file " <> renderLegacyKind fileKind <> " " <> T.pack path | (fileKind, path) <- (.files) legacyRecord]+        renameFile currentPath legacyPath+        TIO.writeFile legacyPath legacyContents+        migrationTreeBefore <- treeSnapshot out+        refused <- run False+        refused `shouldSatisfy` \case+          Left [SidecarMigrationRequired [move]] -> (.moveDisposition) move == ConvertLegacyConformanceLedger+          _ -> False+        treeSnapshot out `shouldReturn` migrationTreeBefore+        applied <- run True >>= either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure+        map (.moveDisposition) ((.sidecarMoves) applied) `shouldBe` [ConvertLegacyConformanceLedger]+        doesFileExist legacyPath `shouldReturn` False+        TIO.readFile backupPath `shouldReturn` legacyContents+        migrated <- TIO.readFile currentPath+        (.serviceKey) <$> parseConformancePackageRecord migrated+          `shouldBe` Just (StandaloneConformanceService ((.name) ctx))++        TIO.writeFile+          currentPath+          ( T.replace+              ("service-key standalone " <> (.name) ctx)+              "service-key standalone another-service"+              migrated+          )+        mismatchBefore <- treeSnapshot out+        mismatch <- run False+        mismatch `shouldSatisfy` \case+          Left [ConformancePackageRefusal ConformancePackageRecordMismatch {}] -> True+          _ -> False+        treeSnapshot out `shouldReturn` mismatchBefore+    it "refuses a bannerless package file before changing any runtime byte" $ do+      withTempDirectory "keiro-dsl-conformance-atomic" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/hospital-surge.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+            runtimePackage = RuntimePackageName "hospital-runtime"+        modules <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planTestServiceScaffoldWithRuntimePackage (Just runtimePackage) ctx service)+        executeServiceScaffoldWithRuntimePackage (Just runtimePackage) out False "hospital-surge.keiro" ((.sourceLanguage) parsed) ctx service modules+          >>= either (\failure -> expectationFailure (show failure)) (const (pure ()))+        facade <- case [moduleValue | moduleValue <- modules, ".Conformance" `T.isSuffixOf` moduleNameOf ((.path) moduleValue)] of+          [moduleValue] -> pure moduleValue+          values -> expectationFailure ("expected one facade, got " <> show (map (.path) values)) >> fail "unreachable"+        let facadePath = out </> (.path) facade+            serviceKey = (.name) ctx+            cabalPath = out </> conformancePackageDirectory (StandaloneConformanceService serviceKey) </> T.unpack ("keiro-" <> cabaliseConformanceService serviceKey <> "-conformance.cabal")+        TIO.appendFile facadePath "-- would be overwritten if runtime execution began\n"+        TIO.writeFile cabalPath "hand-owned cabal file\n"+        packageTree <- treeSnapshot out+        refused <- executeServiceScaffoldWithRuntimePackage (Just runtimePackage) out False "hospital-surge.keiro" ((.sourceLanguage) parsed) ctx service modules+        refused `shouldSatisfy` isLeft+        treeSnapshot out `shouldReturn` packageTree+    it "keeps a two-aggregate workspace at exactly one Cabal package" $ do+      withTempDirectory "keiro-dsl-conformance-workspace" $ \out -> do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        let runtimePackage = Just (RuntimePackageName "workspace-runtime")+        plan <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure (planWorkspaceScaffoldWithRuntimePackageAndGoldens [] runtimePackage "goldens" (workspaceContext workspace) workspace)+        length [() | NAggregate {} <- (.nodes) (checkedSpec (checkedWorkspace workspace))] `shouldBe` 2+        executeWorkspaceScaffold out False plan >>= either (\failure -> expectationFailure (show failure)) (const (pure ()))+        packageDirectories <- filter (T.isPrefixOf "keiro-dsl-conformance.workspace." . T.pack) <$> listDirectory out+        packageDirectories `shouldBe` ["keiro-dsl-conformance.workspace.demo-project"]+        case packageDirectories of+          [packageDirectory] -> do+            cabalFiles <- filter ((== ".cabal") . takeExtension) <$> listDirectory (out </> packageDirectory)+            length cabalFiles `shouldBe` 1+          _ -> expectationFailure "expected one package directory"+    it "scaffolds the multi-member proof idempotently through the public CLI" $ do+      withTempDirectory "keiro-dsl-conformance-proof-cli" $ \base -> do+        let fixture = "test/conformance-service-package"+            copied = base </> "fixture"+            out = copied </> "runtime/src"+            sourcePaths =+              [ "service.keiro-workspace",+                "domain/alpha.keiro",+                "domain/beta.keiro",+                "domain/evidence.keiro",+                "domain/shared.keiro"+              ]+        fixtureManifest <- resolveTestPath (fixture </> "service.keiro-workspace") >>= canonicalizePath+        let fixtureRoot = takeDirectory fixtureManifest+        forM_ sourcePaths $ \relative -> TIO.readFile (fixtureRoot </> relative) >>= writeFileWithParents (copied </> relative)+        (firstCode, firstOut, firstErr) <- runKeiroDsl ["scaffold", copied </> "service.keiro-workspace", "--out", out]+        unless (firstCode == ExitSuccess) (expectationFailure (firstOut <> firstErr))+        firstTree <- treeSnapshot out+        length [path | (path, _) <- firstTree, takeExtension path == ".cabal"] `shouldBe` 1+        length [path | (path, _) <- firstTree, "Generated/Conformance.hs" `T.isSuffixOf` T.pack path] `shouldBe` 1+        let recordPath = out </> conformancePackageDirectory (WorkspaceConformanceService "workspace-proof") </> conformanceRecordFileName+        record <- parseConformancePackageRecord <$> TIO.readFile recordPath+        (.serviceKey) <$> record `shouldBe` Just (WorkspaceConformanceService "workspace-proof")+        (secondCode, secondOut, secondErr) <- runKeiroDsl ["scaffold", copied </> "service.keiro-workspace", "--out", out]+        unless (secondCode == ExitSuccess) (expectationFailure (secondOut <> secondErr))+        secondErr `shouldSatisfy` isInfixOfString "keiro-workspace-proof-conformance.cabal (unchanged)"+        secondErr `shouldSatisfy` isInfixOfString "Expectations.hs (skipped: already present)"+        secondErr `shouldSatisfy` isInfixOfString "Generated.Conformance"+        treeSnapshot out `shouldReturn` firstTree+    it "keeps Expectations fixed and turns the generated target red for a changed workflow fact" $ do+      withTempDirectory "keiro-dsl-conformance-proof-mutation" $ \base -> do+        fixtureManifest <- resolveTestPath "test/conformance-service-package/service.keiro-workspace" >>= canonicalizePath+        let fixtureRoot = takeDirectory fixtureManifest+        let copied = base </> "fixture"+            out = copied </> "runtime/src"+            path = copied </> "domain/evidence.keiro"+            expectationsPath = out </> "keiro-dsl-conformance.workspace.workspace-proof/src/KeiroConformance/Expectations.hs"+        copyTextTree fixtureRoot copied+        acceptedExpectations <- TIO.readFile expectationsPath+        TIO.readFile path+          >>= TIO.writeFile path . T.replace "name \"workspace-proof-workflow\"" "name \"workspace-proof-workflow-v2\""+        (scaffoldCode, scaffoldOut, scaffoldErr) <- runKeiroDsl ["scaffold", copied </> "service.keiro-workspace", "--out", out]+        unless (scaffoldCode == ExitSuccess) (expectationFailure (scaffoldOut <> scaffoldErr))+        TIO.readFile expectationsPath `shouldReturn` acceptedExpectations+        let repositoryRoot = takeDirectory (takeDirectory (takeDirectory fixtureRoot))+            projectPath = base </> "mutation.project"+            buildDirectory = base </> "dist-newstyle"+            packageRoot = out </> "keiro-dsl-conformance.workspace.workspace-proof"+        localSourcePackages <-+          filterM+            doesDirectoryExist+            [ repositoryRoot </> "keiro",+              repositoryRoot </> "keiro-core"+            ]+        -- Compiling this generated package is a repository integration proof:+        -- it deliberately builds against the sibling keiro and keiro-core+        -- source packages. The package-owned scaffold and immutable-+        -- Expectations assertions above remain active in an unpacked sdist.+        unless (null localSourcePackages) $ do+          let packageRoots = localSourcePackages <> [copied </> "runtime", packageRoot]+          TIO.writeFile+            projectPath+            ( T.unlines $+                ["packages:"]+                  <> map (("  " <>) . T.pack) packageRoots+                  <> [ "",+                       "allow-newer:",+                       "  haxl:time"+                     ]+            )+          (testCode, testOut, testErr) <-+            readProcessWithExitCode+              "cabal"+              [ "test",+                "--project-file=" <> projectPath,+                "--builddir=" <> buildDirectory,+                "keiro-workspace-proof-conformance"+              ]+              ""+          testCode `shouldNotBe` ExitSuccess+          (testOut <> testErr)+            `shouldSatisfy` isInfixOfString "FAIL  workflow/WorkspaceProofWorkflow/name expected=\"workspace-proof-workflow\" actual=\"workspace-proof-workflow-v2\""++  describe "new <kind> skeletons (M5)" $ do+    forM_ skeletonKinds $ \skeletonKind ->+      it ("the " <> T.unpack skeletonKind <> " skeleton selects and preserves the stable language") $+        assertSkeletonUsesStableLanguage skeletonKind+    it "every skeleton parses and validates with zero error diagnostics" $+      mapM_ assertSkeletonValid skeletonKinds+    it "every skeleton passes the scaffold refusal gates" $+      mapM_ assertSkeletonScaffoldable skeletonKinds+    -- `derive … hole` is mandatory emit grammar. While it carried a warning, a+    -- freshly generated emit service could never satisfy the documented CI+    -- recipe, no matter what its author did. See ExecPlan 199.+    it "every skeleton without a confirmed benign inversion satisfies the documented --deny-warnings CI gate" $+      withTempDirectory "keiro-dsl-skeleton-deny" $ \out ->+        -- router and process are deliberately absent: their idiomatic+        -- on-duplicate/on-reject spellings are confirmed benign inversions+        -- (RouterBenignInversion/ProcessBenignInversion), so those services+        -- gate CI with a selective --deny list rather than --deny-warnings.+        forM_ ["emit", "intake", "aggregate", "contract", "workqueue", "workflow"] $ \kind ->+          case skeletonFor kind of+            Left err -> expectationFailure (T.unpack err)+            Right source -> do+              let specPath = out </> T.unpack kind <> ".keiro"+              TIO.writeFile specPath source+              (exitCode, stdoutText, stderrText) <-+                runKeiroDsl ["check", specPath, "--min-language", "4", "--deny-warnings"]+              unless (exitCode == ExitSuccess) $+                expectationFailure (T.unpack kind <> " skeleton failed the gate:\n" <> stdoutText <> stderrText)+              stderrText `shouldNotContain` "escalated to failure"+    it "rejects an unknown kind with a helpful message" $+      case skeletonFor "bogus" of+        Left msg -> ("Valid kinds:" `T.isInfixOf` msg) `shouldBe` True+        Right _ -> expectationFailure "expected an error for an unknown kind"++  describe "firewall self-check (M3)" $ do+    it "flags a forbidden operator in a Generated module" $ do+      let m = ScaffoldModule {path = "Gen/Foo.hs", text = "x = a ./= b", kind = Generated, origin = "test"}+      firewallBreaches [m] `shouldBe` [("Gen/Foo.hs", "./=", 1)]+    it "ignores forbidden operators in a HoleStub module (holes own them)" $ do+      let m = ScaffoldModule {path = "Foo/Holes.hs", text = "x = lit 1 .== y", kind = HoleStub, origin = "test"}+      firewallBreaches [m] `shouldBe` []+    it "matches `lit` as a word, not a substring of quality/split" $ do+      let clean = ScaffoldModule {path = "Gen/Q.hs", text = "quality = split facility", kind = Generated, origin = "test"}+          dirty = ScaffoldModule {path = "Gen/L.hs", text = "v = lit foo", kind = Generated, origin = "test"}+      firewallBreaches [clean] `shouldBe` []+      firewallBreaches [dirty] `shouldBe` [("Gen/L.hs", "lit", 1)]+    it "skips strings and comments and maximal-munches symbolic tokens" $ do+      let clean = syntheticGenerated "Gen/Clean.hs" "wire = \"lit .== B.slot\"\n-- x =: y\nx = a .<= b"+          dirty = syntheticGenerated "Gen/Dirty.hs" "x = a .< b\ny = c =: d"+      firewallBreaches [clean] `shouldBe` [("Gen/Clean.hs", ".<=", 3)]+      firewallBreaches [dirty] `shouldBe` [("Gen/Dirty.hs", ".<", 1), ("Gen/Dirty.hs", "=:", 2)]+    it "guards keiki imports while allowing the generated Core allowlist" $ do+      let forbidden = syntheticGenerated "Gen/Builder.hs" "import Keiki.Builder"+          restricted = syntheticGenerated "Gen/CoreBad.hs" "import Keiki.Core (lit)"+          allowed = syntheticGenerated "Gen/CoreGood.hs" "import Keiki.Core (RegFile (..), HsPred, step)"+      firewallBreaches [forbidden] `shouldBe` [("Gen/Builder.hs", "import:Keiki.Builder", 1)]+      firewallBreaches [restricted] `shouldBe` [("Gen/CoreBad.hs", "import:Keiki.Core", 1)]+      firewallBreaches [allowed] `shouldBe` []+    it "exempts only the authoritative generated transducer module path" $ do+      let expressions = syntheticGenerated "Gen/Aggregate/Expressions.hs" "import Keiki.Core qualified as K\nx = K.lit 1"+          transducer = syntheticGenerated "Gen/Aggregate/Transducer.hs" "import Keiki.Builder qualified as B\nx = B.slot"+          ordinary = syntheticGenerated "Gen/Aggregate/Projection.hs" "import Keiki.Builder qualified as B"+      firewallBreaches [expressions, transducer]+        `shouldBe` [("Gen/Aggregate/Expressions.hs", "import:Keiki.Core", 1)]+      firewallBreaches [ordinary] `shouldBe` [("Gen/Aggregate/Projection.hs", "import:Keiki.Builder", 1)]+    it "finds no breach in real scaffolder output (aggregate + process fixtures)" $ do+      aggMods <- scaffoldFixture "test/fixtures/reservation.keiro"+      procMods <- legacyScaffoldProcessFixture "test/fixtures/hospital-surge.keiro"+      firewallBreaches (aggMods <> procMods) `shouldBe` []++  describe "generated provenance banners (plan 182 M4)" $ do+    it "stamps the running package version, effective language, and module origin" $ do+      service <- checkedServiceOf "test/fixtures/contract-v4.keiro"+      let ctx = defaultContext ((checkedSpec service).context)+      case planTestServiceScaffold ctx service of+        Left refusals -> expectationFailure (show refusals)+        Right modules -> do+          let generated = [moduleValue | moduleValue <- modules, (.kind) moduleValue == Generated]+          generated `shouldSatisfy` (not . null)+          forM_ generated $ \moduleValue -> do+            let recognized = filter isGeneratedBannerLine (T.lines ((.text) moduleValue))+                expected = generatedBannerFor (checkedLanguageContract service) ((.origin) moduleValue)+            recognized `shouldBe` [expected]+            expected+              `shouldSatisfy` T.isInfixOf+                ( "keiro-dsl "+                    <> T.pack (showVersion Package.version)+                    <> " (language keiro-dsl 4) from contract emergency"+                )+      workspace <- shouldComposeWorkspace canonicalWorkspacePath+      workspacePlan <- shouldPlanWorkspaceSpec workspace+      forM_ [moduleValue | (moduleValue, _) <- (.modules) workspacePlan, (.kind) moduleValue == Generated] $ \moduleValue ->+        filter isGeneratedBannerLine (T.lines ((.text) moduleValue))+          `shouldBe` [generatedBannerFor (checkedLanguageContract (checkedWorkspace workspace)) ((.origin) moduleValue)]+    it "recognizes only the historical banner and the stamped format" $ do+      let contract = effectiveLanguageContract LegacyUnversioned+      isGeneratedBannerLine generatedBanner `shouldBe` True+      isGeneratedBannerLine (generatedBannerFor contract "aggregate Counter (line 2)") `shouldBe` True+      isGeneratedBannerLine "-- @generated by another tool" `shouldBe` False+      isGeneratedBannerLine codecComparisonBanner `shouldBe` False+    it "migrates a legacy-banner file and keeps repeated scaffold bytes stable" $+      withTempDirectory "keiro-dsl-stamped-banner" $ \out -> do+        spec <- parseInlineSpec "<stamped-banner>" loweringAggregateSpec+        let ctx = defaultContext (spec.context)+        modules <- case planTestScaffold ctx spec of+          Left refusals -> expectationFailure (show refusals) >> pure []+          Right planned -> pure planned+        case [moduleValue | moduleValue <- modules, (.kind) moduleValue == Generated] of+          target : _ -> do+            let path = out </> target.path+                stamped = generatedBannerFor (effectiveLanguageContract LegacyUnversioned) ((.origin) target)+                legacyText = T.replace stamped generatedBanner ((.text) target)+            createDirectoryIfMissing True (takeDirectory path)+            TIO.writeFile path legacyText+            first <- executeScaffold out False "counter.keiro" ctx spec modules+            first `shouldSatisfy` isSuccessfulScaffold+            firstTree <- treeSnapshot out+            second <- executeScaffold out False "counter.keiro" ctx spec modules+            second `shouldSatisfy` isSuccessfulScaffold+            treeSnapshot out `shouldReturn` firstTree+            TIO.readFile path `shouldReturn` (.text) target+          [] -> expectationFailure "counter scaffold has no Generated module"++  describe "service-aware fixture helpers" $ do+    it "retains version-4 contract TypeIDs and their durable admission identities" $ do+      service <- checkedServiceOf "test/fixtures/contract-v4.keiro"+      modules <- scaffoldFixture "test/fixtures/contract-v4.keiro"+      let contractModule = generatedTextEndingIn "Contract.hs" modules+          identities = idDomainIdentitiesForService service+      contractModule `shouldSatisfy` T.isInfixOf "incidentId :: !(KindID \"inc\")"+      contractModule `shouldSatisfy` T.isInfixOf "reservationId :: !(KindID \"rsv\")"+      identities+        `shouldContain` ["id-domain|name=contract:emergency.IncidentTransferNeedDeclared.incidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text"]++  describe "scaffold gates" $ do+    it "reports case-folded generated paths through the complete check diagnostics" $ do+      spec <- specOf "test/fixtures/reservation.keiro"+      case [aggregate | NAggregate aggregate <- (.nodes) spec] of+        aggregate : _ -> do+          let caseVariant =+                specWithNodes+                  [ NAggregate aggregate,+                    NAggregate (aggregateWithName (T.toUpper aggregate.name) aggregate)+                  ]+                  spec+              diagnostics =+                checkTestServiceDiagnostics+                  Nothing+                  (defaultContext (caseVariant.context))+                  (legacyCheckedService caseVariant)+          map (.code) diagnostics `shouldContain` [GeneratedPathCollision]+          case [ diagnostic+               | diagnostic <- diagnostics,+                 (.code) diagnostic == GeneratedPathCollision,+                 "Domain.hs" `T.isInfixOf` (.message) diagnostic+               ] of+            [diagnostic] -> do+              (.line) diagnostic `shouldBe` unLoc ((.loc) aggregate)+              (.relatedLocations) diagnostic `shouldSatisfy` (not . null)+              (.message) diagnostic `shouldSatisfy` T.isInfixOf "case-insensitive filesystem"+            found -> expectationFailure ("expected one generated-path diagnostic, got " <> show found)+          withTempDirectory "keiro-dsl-check-path-collision" $ \root -> do+            let sourcePath = root </> "collision.keiro"+            version <- maybe (expectationFailure "language version 4 missing" >> fail "unreachable") pure (languageVersion 4)+            TIO.writeFile sourcePath (renderSource (ParsedSource (DeclaredLanguage version noLoc) caseVariant))+            (exitCode, out, err) <- runKeiroDsl ["check", sourcePath]+            exitCode `shouldBe` ExitFailure 1+            out `shouldBe` ""+            err `shouldContain` "error[GeneratedPathCollision]"+        [] -> expectationFailure "reservation fixture has no aggregate"+    it "uses lowering before module planning in both scaffold planners" $ do+      spec <- specOf "test/fixtures/emit.keiro"+      case [contract | NContract contract <- (.nodes) spec] of+        contract : _ -> do+          let defective =+                mapPublisher+                  (publisherWithBackoff (BackoffSpec "exponential" "2s" Nothing Nothing))+                  (specWithNodes (NContract contract : spec.nodes) spec)+              ctx = defaultContext (defective.context)+              workspace = oneMemberWorkspace "emit.keiro" defective+          case (planTestScaffold ctx defective, planWorkspaceScaffold "goldens" ctx workspace) of+            (Left (LoweringRefusal singleReasons : _), Left (LoweringRefusal workspaceReasons : _)) ->+              workspaceReasons `shouldBe` singleReasons+            results -> expectationFailure ("expected lowering first from both planners, got " <> show results)+        [] -> expectationFailure "emit fixture has no contract"+    it "maps import cycles and planner invariants into stable check codes" $ do+      planningRefusalDiagnostics [ImportCycle ["A", "B", "A"]]+        `shouldSatisfy` any ((== GeneratedImportCycle) . (.code))+      planningRefusalDiagnostics [BehaviorRefusal [Behavior.DuplicateBehaviorIdentity "duplicate" [Loc 9]]]+        `shouldSatisfy` any (\diagnostic -> (.code) diagnostic == BehaviorDerivationInvalid && (.line) diagnostic == 9)+      planningRefusalDiagnostics [DuplicateConformanceFactKeys [DuplicateServiceFactKey "duplicate"]]+        `shouldSatisfy` any ((== ConformanceFactKeyCollision) . (.code))+      planningRefusalDiagnostics [SemanticContractMismatch "test mismatch"]+        `shouldSatisfy` any ((== GeneratedPlanningInvariantViolation) . (.code))+      spec <- specOf "test/fixtures/consumer-types.keiro"+      let cyclic = spec {mapped = map moveArtifactBindingIntoGenerated ((.mapped) spec)}+      checkTestServiceDiagnostics Nothing (defaultContext (cyclic.context)) (stableCheckedService cyclic)+        `shouldSatisfy` any ((== GeneratedImportCycle) . (.code))+    it "refuses duplicate and case-folded module paths with both origins" $ do+      spec <- specOf "test/fixtures/reservation.keiro"+      case [aggregate | NAggregate aggregate <- (.nodes) spec] of+        aggregate : _ -> do+          let duplicate = specWithNodes [NAggregate aggregate, NAggregate aggregate] spec+              caseVariant = specWithNodes [NAggregate aggregate, NAggregate (aggregateWithName (T.toUpper aggregate.name) aggregate)] spec+          planTestScaffold (defaultContext (spec.context)) duplicate `shouldSatisfy` hasPathCollisionWithTwoOrigins+          planTestScaffold (defaultContext (spec.context)) caseVariant `shouldSatisfy` hasPathCollisionWithTwoOrigins+        [] -> expectationFailure "reservation fixture has no aggregate"+    it "refuses a bannerless Generated target without changing its bytes" $+      withTempDirectory "keiro-dsl-banner" $ \out -> do+        spec <- specOf "test/fixtures/reservation.keiro"+        let ctx = defaultContext (spec.context)+        case planTestScaffold ctx spec of+          Left refusals -> expectationFailure ("unexpected planning refusal: " <> show refusals)+          Right modules -> case [m | m <- modules, (.kind) m == Generated] of+            generated : _ -> do+              let target = out </> (.path) generated+              createDirectoryIfMissing True (takeDirectory target)+              TIO.writeFile target "hand owned\n"+              result <- executeScaffold out False "test/fixtures/reservation.keiro" ctx spec modules+              result `shouldSatisfy` isMissingBannerRefusal+              TIO.readFile target `shouldReturn` "hand owned\n"+              forced <- executeScaffold out True "test/fixtures/reservation.keiro" ctx spec modules+              forced `shouldSatisfy` isSuccessfulScaffold+              TIO.readFile target `shouldReturn` (.text) generated+            [] -> expectationFailure "reservation scaffold has no Generated module"+    it "records reaction identity and refuses decoder hole contract drift" $+      withTempDirectory "keiro-dsl-process-hole-contract" $ \out -> do+        parsed <- parsedSourceOf "test/fixtures/process-reactions-minimal.keiro"+        let service = checkedSource parsed+            spec = checkedSpec service+            ctx = defaultContext (spec.context)+        modules <- case planTestServiceScaffold ctx service of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right planned -> pure planned+        firstResult <- executeServiceScaffold out False "test/fixtures/process-reactions-minimal.keiro" ((.sourceLanguage) parsed) ctx service modules+        first <- case firstResult of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right report -> pure report+        ledger <- TIO.readFile ((.recordPath) first)+        ledger `shouldSatisfy` T.isInfixOf "process-reaction {"+        renderScaffoldReport first `shouldSatisfy` any (T.isInfixOf "decodeIncidentReactionInput :: RecordedEvent -> Maybe IncidentReactionInput")+        case [out </> (.path) module_ | module_ <- modules, "ProcessHoles.hs" `T.isSuffixOf` T.pack ((.path) module_)] of+          [holePath] -> do+            original <- TIO.readFile holePath+            let drifted = T.replace "-- keiro-dsl process-hole contract v1" "-- keiro-dsl process-hole contract v999" original+            TIO.writeFile holePath drifted+            second <- executeServiceScaffold out False "test/fixtures/process-reactions-minimal.keiro" ((.sourceLanguage) parsed) ctx service modules+            second `shouldSatisfy` \case+              Left [HoleContractDrift [(path, expected, actual)]] ->+                "ProcessHoles.hs" `T.isSuffixOf` T.pack path+                  && expected == "-- keiro-dsl process-hole contract v1"+                  && actual == "-- keiro-dsl process-hole contract v999"+              _ -> False+            TIO.readFile holePath `shouldReturn` drifted+          paths -> expectationFailure ("expected one process decoder hole, got " <> show paths)+    it "reports renamed-node modules as stale without deleting them" $+      withTempDirectory "keiro-dsl-stale-rename" $ \out -> do+        spec <- parseInlineSpec "<stale-rename>" loweringAggregateSpec+        first <- executePlannedScaffold out "counter.keiro" (defaultContext (spec.context)) spec+        let renamed = specWithNodes (map renameCounter spec.nodes) spec+        second <- executePlannedScaffold out "counter.keiro" (defaultContext (renamed.context)) renamed+        let oldDomain = onlyPathEndingIn "Counter/Domain.hs" (map fst ((.dispositions) first))+            oldHoles = onlyPathEndingIn "Counter/Holes.hs" (map fst ((.dispositions) first))+        (.stale) second `shouldSatisfy` \stale ->+          StaleModule Generated oldDomain (Just ExactGeneratedBannerPresent) `elem` stale+            && StaleModule HoleStub oldHoles Nothing `elem` stale+        doesFileExist (out </> oldDomain) `shouldReturn` True+        doesFileExist (out </> oldHoles) `shouldReturn` True+        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "exact generated banner present; verify unchanged bytes before deleting")+        renderScaffoldReport second `shouldSatisfy` all (not . T.isInfixOf "safe to delete")+    it "preserves a stale generated path whose exact banner is missing" $+      withTempDirectory "keiro-dsl-stale-banner" $ \out -> do+        spec <- parseInlineSpec "<stale-banner>" loweringAggregateSpec+        first <- executePlannedScaffold out "counter.keiro" (defaultContext (spec.context)) spec+        let oldDomain = onlyPathEndingIn "Counter/Domain.hs" (map fst ((.dispositions) first))+            renamed = specWithNodes (map renameCounter spec.nodes) spec+        TIO.writeFile (out </> oldDomain) "-- generated by something else\n"+        second <- executePlannedScaffold out "counter.keiro" (defaultContext (renamed.context)) renamed+        (.stale) second `shouldSatisfy` elem (StaleModule Generated oldDomain (Just ExactGeneratedBannerMissing))+        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "exact generated banner missing; preserve and review")+        TIO.readFile (out </> oldDomain) `shouldReturn` "-- generated by something else\n"+    it "reports the entire old tree across a module-root flip" $+      withTempDirectory "keiro-dsl-stale-root" $ \out -> do+        spec <- parseInlineSpec "<stale-root>" loweringAggregateSpec+        let initialCtx = defaultContext (spec.context)+            rootedCtx = contextWithModuleRoot "Acme" initialCtx+        first <- executePlannedScaffold out "counter.keiro" initialCtx spec+        second <- executePlannedScaffold out "moved-counter.keiro" rootedCtx spec+        (.stale) second+          `shouldMatchList` [ StaleModule ((.kind) m) ((.path) m) (if (.kind) m == Generated then Just ExactGeneratedBannerPresent else Nothing)+                            | (m, _) <- (.dispositions) first+                            ]+        forM_ ((.stale) second) $ \stale -> doesFileExist (out </> (.path) stale) `shouldReturn` True+        renderScaffoldReport second `shouldSatisfy` any (T.isInfixOf "previous scaffold record used spec counter.keiro")+    it "reports moved generated modules across a layout flip" $+      withTempDirectory "keiro-dsl-stale-layout" $ \out -> do+        spec <- parseInlineSpec "<stale-layout>" loweringAggregateSpec+        let initialCtx = defaultContext (spec.context)+            collocatedCtx = initialCtx {placement = CollocatedLeaf}+        first <- executePlannedScaffold out "counter.keiro" initialCtx spec+        second <- executePlannedScaffold out "counter.keiro" collocatedCtx spec+        let oldGenerated = [StaleModule Generated ((.path) m) (Just ExactGeneratedBannerPresent) | (m, _) <- (.dispositions) first, (.kind) m == Generated]+        (.stale) second `shouldSatisfy` all (`elem` oldGenerated)+        length ((.stale) second) `shouldBe` length oldGenerated+    it "writes a parseable record and no stale section for a fresh output" $+      withTempDirectory "keiro-dsl-record" $ \out -> do+        spec <- parseInlineSpec "<fresh-record>" loweringAggregateSpec+        let ctx = defaultContext (spec.context)+        report <- executePlannedScaffold out "counter.keiro" ctx spec+        (.stale) report `shouldBe` []+        renderScaffoldReport report `shouldSatisfy` all (not . T.isPrefixOf "stale:")+        contents <- TIO.readFile (out </> recordFileName (spec.context))+        requirements <- either (\errors -> expectationFailure (show errors) >> pure []) pure (Behavior.deriveBehaviorRequirements spec)+        let expected =+              ScaffoldRecord+                { specPath = "counter.keiro",+                  moduleRoot = "",+                  layout = "prefixed",+                  sourceLanguage = LegacyUnversioned,+                  languageContract = effectiveLanguageContract LegacyUnversioned,+                  namingEdition = IdiomaticNamingV2,+                  moduleRoles = [ScaffoldModuleRoleRow (moduleRole m) ((.kind) m) ((.path) m) | (m, _) <- (.dispositions) report],+                  files = [((.kind) m, (.path) m) | (m, _) <- (.dispositions) report],+                  mappings = [],+                  idDomains = [],+                  nominalEqualities = [],+                  bindingObligations = [],+                  behaviorRequirements = Behavior.behaviorRecordRows requirements,+                  projectionCatalogFacts = [],+                  queryContractBaseline = False,+                  queryContracts = either (const []) id (queryContractIdentities spec),+                  routerSelections = [],+                  processReactions = [],+                  semanticImpact = Just (semanticImpactSnapshotForSpec spec)+                }+            sourceRows = filter ("source-language " `T.isPrefixOf`) (T.lines contents)+            withoutSourceRows = T.unlines (filter (not . T.isPrefixOf "source-language ") (T.lines contents))+            semanticRows = filter ("semantic-contract " `T.isPrefixOf`) (T.lines contents)+            withoutSemanticRows = T.unlines (filter (not . T.isPrefixOf "semantic-contract ") (T.lines contents))+        parseRecord contents `shouldBe` Just expected+        contents `shouldNotSatisfy` T.isInfixOf "query-contract-baseline"+        parseRecord withoutSourceRows `shouldBe` Just expected+        parseRecord withoutSemanticRows `shouldBe` Just expected+        case sourceRows of+          [sourceRow] -> do+            parseRecord (T.replace sourceRow (sourceRow <> "\n" <> sourceRow) contents) `shouldBe` Nothing+            parseRecord (T.replace sourceRow "source-language {malformed}" contents) `shouldBe` Nothing+          _ -> expectationFailure "expected exactly one source-language row"+        case semanticRows of+          [semanticRow] -> do+            parseRecord (T.replace semanticRow (semanticRow <> "\n" <> semanticRow) contents) `shouldBe` Nothing+            parseRecord (T.replace semanticRow "semantic-contract {malformed}" contents) `shouldBe` Nothing+            parseRecord (T.replace "\"languageVersion\":1" "\"languageVersion\":2" contents) `shouldBe` Nothing+          _ -> expectationFailure "expected exactly one semantic-contract row"+        parseRecord (T.replace "spec: " "future-field: retained\nspec: " contents) `shouldBe` parseRecord contents+        parseRecord (T.replace "record v1" "record v2" contents) `shouldBe` Nothing+    it "records declared provenance and reports a header-only scaffold drift" $+      withTempDirectory "keiro-dsl-language-drift" $ \out -> do+        spec <- parseInlineSpec "<language-drift>" loweringAggregateSpec+        let ctx = defaultContext (spec.context)+        modules <- case planTestScaffold ctx spec of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right planned -> pure planned+        _ <- executePlannedScaffold out "counter.keiro" ctx spec+        case languageVersion 1 of+          Nothing -> expectationFailure "version 1 was not constructible"+          Just version -> do+            let declared = DeclaredLanguage version noLoc+            result <- executeScaffoldWithLanguage out False "counter.keiro" declared ctx spec modules+            case result of+              Left refusals -> expectationFailure (show refusals)+              Right report -> do+                (.sourceLanguageDrift) report+                  `shouldBe` Just (SourceLanguageDrift LegacyUnversioned declared)+                contents <- TIO.readFile ((.recordPath) report)+                (.sourceLanguage) <$> parseRecord contents `shouldBe` Just declared++  describe "faithful scaffold lowering" $ do+    it "escapes a trailing-backslash payload literal exactly once" $ do+      spec <- specOf "test/fixtures/hospital-surge.keiro"+      case [process | NProcess process <- (.nodes) spec] of+        process : _ -> do+          let timer = timerNodeWithPayload [FieldBinding "kind" (Just "\"follow-up\\\"")] (legacyProcessTimer process)+              modules = scaffoldProcess (defaultContext (spec.context)) (processWithTimer timer process)+          generatedTextEndingIn "Process.hs" modules+            `shouldSatisfy` T.isInfixOf "\"kind\" .= (\"follow-up\\\\\" :: Value)"+        [] -> expectationFailure "hospital-surge fixture has no process"+    it "preserves quoted Text register initials and refuses unsafe register shapes" $ do+      spec <- parseInlineSpec "<register-initials>" loweringAggregateSpec+      let modules = scaffoldAggregate (defaultContext (spec.context)) spec =<< [aggregate | NAggregate aggregate <- (.nodes) spec]+          domain = generatedTextEndingIn "Domain.hs" modules+      domain `shouldSatisfy` T.isInfixOf "RCons (Proxy @\"note\") \"hello world\""+      scaffoldRefusals spec `shouldBe` []+      bare <- parseInlineSpec "<bare-text-initial>" (T.replace "\"hello world\"" "hello" loweringAggregateSpec)+      scaffoldRefusals bare `shouldSatisfy` any (T.isInfixOf "RegTextInitialNotQuoted")+      unsupported <- parseInlineSpec "<unsupported-field>" (T.replace "count:Int" "count:Json" loweringAggregateSpec)+      scaffoldRefusals unsupported `shouldSatisfy` any (T.isInfixOf "FieldTypeUnrepresentable")+    it "lowers seconds, minutes, hours, and both backoff constructors faithfully" $ do+      windowSeconds "90s" `shouldBe` Right 90+      windowSeconds "5m" `shouldBe` Right 300+      windowSeconds "2h" `shouldBe` Right 7200+      emitSource <- readTestText "test/fixtures/emit.keiro"+      let exponentialSource = T.replace "backoff constant 2s" "backoff exponential 2s max=60s multiplier=2.0" emitSource+      exponential <- parseInlineSpec "<exponential-backoff>" exponentialSource+      case [publisher | NPublisher publisher <- (.nodes) exponential] of+        publisher : _ -> do+          let generated = generatedTextEndingIn "Publisher.hs" (scaffoldPublisher (defaultContext (exponential.context)) publisher)+          generated `shouldSatisfy` T.isInfixOf "ExponentialBackoff ExponentialBackoffOptions { initial = 2, maxDelay = 60, multiplier = 2.0 }"+          parseSpec "<exponential-round-trip>" (renderSpec exponential) `shouldBe` Right exponential+        [] -> expectationFailure "emit fixture has no publisher"+      constant <- parseInlineSpec "<constant-backoff>" (T.replace "backoff constant 2s" "backoff constant 2m" emitSource)+      case [publisher | NPublisher publisher <- (.nodes) constant] of+        publisher : _ -> generatedTextEndingIn "Publisher.hs" (scaffoldPublisher (defaultContext (constant.context)) publisher) `shouldSatisfy` T.isInfixOf "ConstantBackoff 120"+        [] -> expectationFailure "emit fixture has no publisher"+    it "refuses incomplete exponential backoff and rejects unknown window units" $ do+      emitSource <- readTestText "test/fixtures/emit.keiro"+      incomplete <- parseInlineSpec "<incomplete-backoff>" (T.replace "backoff constant 2s" "backoff exponential 2s" emitSource)+      scaffoldRefusals incomplete `shouldSatisfy` any (T.isInfixOf "BackoffExponentialIncomplete")+      parseSpec "<bad-window>" (T.replace "backoff constant 2s" "backoff constant 2x" emitSource)+        `shouldSatisfy` leftContains "time unit: s, m, or h"+    it "lowers workqueue retry windows in minutes to seconds" $ do+      queueSource <- readTestText "test/fixtures/reservation-work.keiro"+      queueSpec <- parseInlineSpec "<minute-queue>" (T.replace "5s" "5m" queueSource)+      case [workqueue | NWorkqueue workqueue <- (.nodes) queueSpec] of+        workqueue : _ -> do+          let policy = generatedTextEndingIn "QueuePolicy.hs" (scaffoldWorkqueue (defaultContext (queueSpec.context)) workqueue)+          policy `shouldSatisfy` T.isInfixOf "defaultRetryDelay = RetryDelay 300"+          policy `shouldSatisfy` T.isInfixOf "Retry (RetryDelay 300)"+        [] -> expectationFailure "queue fixture has no workqueue"+    it "uses exact status-map keys and emits total Int harness samples" $ do+      statusSpec <- parseInlineSpec "<exact-status>" exactStatusSpec+      case [aggregate | NAggregate aggregate <- (.nodes) statusSpec] of+        aggregate : _ -> do+          let ctx = defaultContext (statusSpec.context)+              projection = generatedTextEndingIn "Projection.hs" (scaffoldAggregate ctx statusSpec aggregate)+              harness = generatedTextEndingIn "Harness.hs" (harnessFor ctx statusSpec aggregate)+          projection `shouldSatisfy` T.isInfixOf "ReservationUnHeld {} -> Just \"available\""+          harness `shouldSatisfy` T.isInfixOf "CountBumpedData 0"+          harness `shouldNotSatisfy` T.isInfixOf "sample: unsupported"+        [] -> expectationFailure "exact-status spec has no aggregate"++  describe "scaffold" $ do+    it "keeps field DSL names, generated selectors, and wire keys independent" $ do+      source <- readTestText "test/fixtures/aggregate-field-alias.keiro"+      document <- case parseSourceDocument "aggregate-field-alias.keiro" source of+        Left failure -> expectationFailure (show failure) >> fail "unreachable"+        Right value -> pure value+      let ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = document+          service = checkedSource parsedSource+          spec = checkedSpec service+          ctx = defaultContext (spec.context)+          modules = scaffoldServiceModules ctx service+          domain = generatedTextEndingIn "Domain.hs" modules+          codec = generatedTextEndingIn "Codec.hs" modules+      workspace <-+        either+          (\failure -> expectationFailure (show failure) >> fail "unreachable")+          pure+          (oneMemberParsedDocumentWorkspace "aggregate-field-alias.keiro" document)+      validateService service `shouldBe` []+      domain `shouldSatisfy` ((== 2) . T.count "payloadType :: !Text")+      domain `shouldSatisfy` ((== 2) . T.count "serviceRegion :: !Text")+      domain `shouldSatisfy` ((== 2) . T.count "family :: !Text")+      codec `shouldSatisfy` T.isInfixOf "\"type\" .= payload.payloadType"+      codec `shouldSatisfy` T.isInfixOf "\"region_code\" .= payload.serviceRegion"+      codec `shouldSatisfy` T.isInfixOf "o .: \"region_code\""+      scaffoldServiceModules ctx service `shouldBe` modules+      fmap (map fst . (.modules)) (planWorkspaceScaffold "goldens" ctx workspace)+        `shouldBe` planIndexedServiceScaffold sourceIndex ctx service++      newSpec <- parseInlineSpec "aggregate-field-alias-v2.keiro" (T.replace "event FieldsCopied =" "event FieldsCopied v2 =" source)+      case goldensForDiff spec newSpec of+        [golden] -> do+          (.json) golden `shouldSatisfy` T.isInfixOf "\"family\":\"sample\""+          (.json) golden `shouldSatisfy` T.isInfixOf "\"type\":\"sample\""+          (.json) golden `shouldSatisfy` T.isInfixOf "\"region_code\":\"sample\""+          (.json) golden `shouldSatisfy` (not . T.isInfixOf "payloadType")+          (.json) golden `shouldSatisfy` (not . T.isInfixOf "serviceRegion")+        goldens -> expectationFailure ("expected one field-alias golden, got " <> show goldens)++    it "keeps aggregate fold identity neutral across field aliases" $ do+      let sourceFor field =+            T.unlines+              [ "language keiro-dsl 4",+                "context field-alias-neutrality",+                "aggregate AliasNeutrality",+                "  regs",+                "  states Open",+                "  command Observe { " <> field <> " }",+                "  event Observed = fields(Observe)",+                "  wire kind=ctorName fields=camelCase schemaVersion=1"+              ]+      base <- checkedServiceFromText "field-alias-base.keiro" (sourceFor "region:Text")+      selectorAlias <- checkedServiceFromText "field-alias-selector.keiro" (sourceFor "region haskell serviceRegion:Text")+      wireAlias <- checkedServiceFromText "field-alias-wire.keiro" (sourceFor "region as \"region_code\":Text")+      let fingerprint service = aggregateFoldFingerprintForService service (onlyAggregate (checkedSpec service))+          codecFor service =+            generatedTextEndingIn+              "Codec.hs"+              (scaffoldServiceModules (defaultContext ((checkedSpec service).context)) service)+      fingerprint selectorAlias `shouldBe` fingerprint base+      fingerprint wireAlias `shouldBe` fingerprint base+      codecFor base `shouldSatisfy` T.isInfixOf "\"region\" .= payload.region"+      codecFor selectorAlias `shouldSatisfy` T.isInfixOf "\"region\" .= payload.serviceRegion"+      codecFor selectorAlias `shouldSatisfy` (not . T.isInfixOf "region_code")+      codecFor wireAlias `shouldSatisfy` T.isInfixOf "\"region_code\" .= payload.region"++    it "synthesizes the exact old wire shape and embeds it in the harness" $ do+      oldSpec <- specOf "test/fixtures/reservation.keiro"+      newSpec <- specOf "test/fixtures/reservation-v2.keiro"+      case goldensForDiff oldSpec newSpec of+        [golden] -> do+          goldenRelativePath golden+            `shouldBe` "hospital-capacity/Reservation/TransferReservationCreated.v1.json"+          (.json) golden+            `shouldBe` "{\"commandId\":\"cmd_01hzy3v7q2e8kaw2m5x0d41n9c\",\"divertStatus\":\"open\",\"hospitalId\":\"hosp_01hzy3v7q2e8kaw2m5x0d41n9c\",\"kind\":\"TransferReservationCreated\",\"lifeCriticalOverride\":true,\"patientAcuity\":\"red\",\"reservationId\":\"rsv_01hzy3v7q2e8kaw2m5x0d41n9c\"}\n"+          (.evidence) golden `shouldBe` SynthesizedWeakStandIn+          let aggregate = onlyAggregate newSpec+              modules =+                harnessForWithGoldens+                  [golden]+                  (defaultContext (newSpec.context))+                  newSpec+                  aggregate+              harness = generatedTextEndingIn "Harness.hs" modules+          harness `shouldSatisfy` T.isInfixOf "golden TransferReservationCreated.v1 decodes"+          harness `shouldSatisfy` T.isInfixOf "\\\"reservationId\\\":\\\"rsv_"+          harness `shouldSatisfy` (not . T.isInfixOf "current-shape stand-in")+        goldens -> expectationFailure ("expected one synthesized golden, got " <> show goldens)+    it "synthesizes complete nested mapped old shapes deterministically and never overwrites captured evidence" $ do+      oldSpec <- specOf "test/fixtures/consumer-types.keiro"+      newSpec <- specOf "test/fixtures/consumer-types-v2.keiro"+      case goldensForDiff oldSpec newSpec of+        [golden] -> do+          (.evidence) golden `shouldBe` SynthesizedWeakStandIn+          (.json) golden `shouldSatisfy` T.isInfixOf "\"artifact\":{"+          (.json) golden `shouldSatisfy` T.isInfixOf "\"location\":{\"contents\":\"sample\",\"tag\":\"local_file\"}"+          (.json) golden `shouldSatisfy` T.isInfixOf "\"labels\":[\"sample\"]"+          (.json) golden `shouldSatisfy` T.isInfixOf "\"revision\":1"+          (.json) golden `shouldSatisfy` T.isInfixOf "\"observedAt\":\"2026-01-01T00:00:00Z\""+          goldensForDiff oldSpec newSpec `shouldBe` [golden]+          withTempDirectory "keiro-golden-preserve" $ \root -> do+            let target = root </> goldenRelativePath golden+            createDirectoryIfMissing True (takeDirectory target)+            TIO.writeFile target "hand captured\n"+            emitGoldenPayloads root oldSpec newSpec `shouldReturn` []+            TIO.readFile target `shouldReturn` "hand captured\n"+          withTempDirectory "keiro-golden-write" $ \root -> do+            let target = root </> goldenRelativePath golden+            emitGoldenPayloads root oldSpec newSpec `shouldReturn` [target]+            TIO.readFile target `shouldReturn` (.json) golden+        goldens -> expectationFailure ("expected one nested synthesized golden, got " <> show goldens)+    it "dispatches shared-version upcasters by wire event type and passes foreign kinds through" $ do+      parsed <- parsedSourceOf "test/fixtures/reservation-dup-upcast-source.keiro"+      let spec = parsed.spec+      case [aggregate | NAggregate aggregate <- (.nodes) spec] of+        [_] -> do+          let modules = scaffoldServiceModules (defaultContext (spec.context)) (checkedSource parsed)+              codec = generatedTextEndingIn "Codec.hs" modules+              holes = case [(.text) m | m <- modules, "/Holes.hs" `T.isSuffixOf` T.pack ((.path) m)] of+                [text] -> text+                _ -> ""+          codec `shouldSatisfy` T.isInfixOf "upcasters = [(1, upcastRungV1)]"+          codec `shouldSatisfy` T.isInfixOf "upcastRungV1 (EventType \"TransferReservationCreated\") value = upcastTransferReservationCreatedV1 value"+          codec `shouldSatisfy` T.isInfixOf "upcastRungV1 (EventType \"TransferReservationConfirmed\") value = upcastTransferReservationConfirmedV1 value"+          codec `shouldSatisfy` T.isInfixOf "upcastRungV1 _ value = Right value"+          holes `shouldSatisfy` T.isInfixOf "receives ONLY TransferReservationCreated payloads"+        _ -> expectationFailure "expected exactly one aggregate"+    it "keeps foreign payloads byte-for-byte and invokes both same-rung event upcasters" $ do+      let payloadA = object ["kind" .= ("AmountScaled" :: T.Text), "amount" .= (2 :: Int)]+          payloadB = object ["kind" .= ("AmountRenamed" :: T.Text), "amount" .= (3 :: Int)]+          foreignPayload = object ["kind" .= ("AmountObserved" :: T.Text), "amount" .= (7 :: Int)]+          upcastA _ = Right (object ["kind" .= ("AmountScaled" :: T.Text), "amount" .= (200 :: Int)])+          upcastB _ = Right (object ["kind" .= ("AmountRenamed" :: T.Text), "amountInCents" .= (300 :: Int)])+          rung (EventType "AmountScaled") = upcastA+          rung (EventType "AmountRenamed") = upcastB+          rung _ = Right+          codec =+            Codec+              { eventTypes = EventType "AmountScaled" :| [EventType "AmountRenamed", EventType "AmountObserved"],+                eventType = const (EventType "AmountObserved"),+                schemaVersion = 2,+                encode = id,+                decode = \_ -> Right,+                upcasters = [(1, rung)]+              } ::+              Codec Value+      decodeRaw codec (EventType "AmountObserved") 1 foreignPayload `shouldBe` Right foreignPayload+      decodeRaw codec (EventType "AmountScaled") 1 payloadA+        `shouldBe` Right (object ["kind" .= ("AmountScaled" :: T.Text), "amount" .= (200 :: Int)])+      decodeRaw codec (EventType "AmountRenamed") 1 payloadB+        `shouldBe` Right (object ["kind" .= ("AmountRenamed" :: T.Text), "amountInCents" .= (300 :: Int)])+    it "never emits a keiki symbolic operator into a Generated module (firewall)" $ do+      mods <- scaffoldFixture "test/fixtures/reservation.keiro"+      firewallBreaches mods `shouldBe` []+    it "marks the Holes module HoleStub and the rest Generated" $ do+      mods <- scaffoldFixture "test/fixtures/reservation.keiro"+      let holes = [m | m <- mods, (.kind) m == HoleStub]+      map (takeFileName . (.path)) holes `shouldBe` ["BehaviorHoles.hs", "Holes.hs"]+      -- Context nominals/internal/replay plus the stable aggregate surface.+      length [m | m <- mods, (.kind) m == Generated] `shouldBe` 10+    it "is deterministic (re-scaffolding yields byte-identical text)" $ do+      a <- scaffoldFixture "test/fixtures/reservation.keiro"+      b <- scaffoldFixture "test/fixtures/reservation.keiro"+      map (.text) a `shouldBe` map (.text) b+    it "keeps retiring as validator-only metadata in generated modules" $ do+      ordinary <- scaffoldFixture "test/fixtures/reservation.keiro"+      retiring <- scaffoldFixture "test/fixtures/reservation-retiring.keiro"+      map (\m -> ((.path) m, (.kind) m, (.text) m)) retiring+        `shouldBe` map (\m -> ((.path) m, (.kind) m, (.text) m)) ordinary+    it "matches the committed compiling Generated conformance modules (modulo whitespace)" $ do+      mods <- scaffoldFixture "test/fixtures/reservation.keiro"+      mapM_ assertMatchesCommitted [m | m <- mods, (.kind) m == Generated]+    it "matches every committed new-surface Generated module (modulo formatting)" $ do+      modules <- scaffoldFixture "test/fixtures/transfer-routing.keiro"+      forM_ [m | m <- modules, (.kind) m == Generated] $ \m -> do+        committed <- readTestText ("test/conformance-newsurface/" <> (.path) m)+        normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) m)+    it "scaffolds the register-free OrderStream smoke target without error" $ do+      mods <- scaffoldFixture "test/fixtures/order.keiro"+      -- Stable and.aggregate.modules.context plus both hand-owned hole surfaces.+      length mods `shouldBe` 12+      firewallBreaches mods `shouldBe` []+      let harness = generatedTextEndingIn "Harness.hs" mods+      harness `shouldSatisfy` T.isInfixOf "prefix = \"forward/replay equality: PlaceOrder from OrderNotStarted -- \""+      harness `shouldSatisfy` T.isInfixOf "prefix <> \"final vertex\""+      harness `shouldNotSatisfy` T.isInfixOf "prefix <> \"register "+    it "emits forward/replay checks with field-distinct Text samples" $ do+      spec <- parseInlineSpec "<forward-replay-samples>" (T.replace "command Bump { count:Int }" "command Bump { count:Int noteText:Text echo:Text }" loweringAggregateSpec)+      case [aggregate | NAggregate aggregate <- (.nodes) spec] of+        aggregate : _ -> do+          let ctx = defaultContext (spec.context)+              harness = generatedTextEndingIn "Harness.hs" (harnessFor ctx spec aggregate)+          harness `shouldSatisfy` T.isInfixOf "\"sample-noteText\" \"sample-echo\""+          harness `shouldSatisfy` T.isInfixOf "prefix = \"forward/replay equality: Bump from CounterPending -- \""+          harness `shouldSatisfy` T.isInfixOf "prefix <> \"register note\""+        [] -> expectationFailure "forward/replay sample spec has no aggregate"+    it "keeps inequality-guard samples distinct from register initials" $ do+      mods <- scaffoldFixture "test/fixtures/subscription.keiro"+      let harness = generatedTextEndingIn "Harness.hs" mods+      harness `shouldSatisfy` T.isInfixOf "ActivateSubscriptionData"+      harness `shouldSatisfy` T.isInfixOf "Paid"+      harness `shouldNotSatisfy` T.isInfixOf "ActivateSubscriptionData (case parseSubscriptionId \"sub_01h455vb4pex5vsknk084sn02q\" of Right parsed -> parsed; Left _ -> error \"generated valid ID sample failed to parse\") (case parseCustomerId \"cust_01h455vb4pex5vsknk084sn02q\" of Right parsed -> parsed; Left _ -> error \"generated valid ID sample failed to parse\") Free"+    it "uses consumer-owned nominal initials for equality-guard samples" $ do+      mods <- scaffoldFixture "test/fixtures/nominal-scalars.keiro"+      let harness = generatedTextEndingIn "Harness.hs" mods+      harness `shouldSatisfy` T.isInfixOf "Bindings.initialOrderId"+      harness `shouldSatisfy` (not . T.isInfixOf "NominalConformance.Bindings.initialOrderId")+      harness `shouldNotSatisfy` T.isInfixOf "case parseOrderId"+    it "emits the canonical reservation register checks" $ do+      mods <- scaffoldFixture "test/fixtures/reservation.keiro"+      let harness = generatedTextEndingIn "Harness.hs" mods+      harness `shouldSatisfy` T.isInfixOf "prefix = \"forward/replay equality: RequestTransferReservation from ReservationUnrequested -- \""+      harness `shouldSatisfy` T.isInfixOf "prefix <> \"register reservationId\""+      harness `shouldSatisfy` T.isInfixOf "prefix <> \"register hospitalId\""+      harness `shouldSatisfy` T.isInfixOf "prefix <> \"register patientAcuity\""+      harness `shouldNotSatisfy` T.isInfixOf "prefix <> \"register reservationState\""+    it "lowers a replay-only transition to B.replayOnly in the holes skeleton (plan 143)" $ do+      twinMods <- scaffoldFixture "test/fixtures/reservation-guard-tightened-twin.keiro"+      map (.text) twinMods `shouldSatisfy` any (T.isInfixOf "B.replayOnly")+      let twinHarness = generatedTextEndingIn "Harness.hs" twinMods+      T.count "forwardReplayRequestTransferReservation ::" twinHarness `shouldBe` 1+      plainMods <- scaffoldFixture "test/fixtures/reservation.keiro"+      map (.text) plainMods `shouldSatisfy` all (not . T.isInfixOf "B.replayOnly")++  describe "service workspace (EP-153)" $ do+    describe "manifest grammar" $ do+      it "round-trips the canonical fixture manifest byte-for-byte" $ do+        source <- readTestText canonicalWorkspacePath+        manifest <- shouldParseManifest canonicalWorkspacePath source+        (.service) manifest `shouldBe` "demo-project"+        (.runtimePackage) manifest `shouldBe` Nothing+        (.moduleRoot) manifest `shouldBe` Just "Demo.Modules.Project"+        (.layout) manifest `shouldBe` Just CollocatedLeaf+        map (.path) (NE.toList ((.members) manifest))+          `shouldBe` [ "domain/project-artifact.keiro",+                       "domain/project.keiro",+                       "domain/shared.keiro"+                     ]+        renderWorkspaceManifest manifest+          `shouldBe` T.intercalate+            "\n"+            [ "service demo-project",+              "module Demo.Modules.Project",+              "layout collocated",+              "spec domain/project-artifact.keiro",+              "spec domain/project.keiro",+              "spec domain/shared.keiro"+            ]+      it "round-trips runtime-package canonically immediately after service" $ do+        manifest <-+          shouldParseManifest "<runtime-package>" $+            T.unlines+              [ "service mori",+                "module Mori.Modules",+                "spec domain/mori.keiro",+                "runtime-package mori-core",+                "layout collocated"+              ]+        (.runtimePackage) manifest `shouldBe` Just (RuntimePackageName "mori-core")+        effectiveRuntimePackage Nothing manifest `shouldBe` Just (RuntimePackageName "mori-core")+        effectiveRuntimePackage (Just (RuntimePackageName "mori-dev")) manifest+          `shouldBe` Just (RuntimePackageName "mori-dev")+        renderWorkspaceManifest manifest+          `shouldBe` T.intercalate+            "\n"+            [ "service mori",+              "runtime-package mori-core",+              "module Mori.Modules",+              "layout collocated",+              "spec domain/mori.keiro"+            ]+      it "validates runtime package names with the mapped-source Cabal grammar" $ do+        mkRuntimePackageName "mori-core" `shouldBe` Right (RuntimePackageName "mori-core")+        mkRuntimePackageName "mori_core" `shouldBe` Left "runtime package 'mori_core' does not follow Cabal package-name grammar"+      it "treats membership as a set: source order changes neither the AST nor the bytes" $ do+        canonical <- readTestText canonicalWorkspacePath >>= shouldParseManifest canonicalWorkspacePath+        reordered <-+          shouldParseManifest "<reordered>" $+            T.unlines+              [ "service demo-project",+                "layout collocated",+                "spec domain/shared.keiro",+                "module Demo.Modules.Project",+                "spec domain/project.keiro",+                "spec ./domain/project-artifact.keiro"+              ]+        reordered `shouldBe` canonical+        renderWorkspaceManifest reordered `shouldBe` renderWorkspaceManifest canonical+      it "satisfies parse . render == id and render . parse . render == render" $+        property $+          forAll genWorkspaceManifest $ \manifest ->+            let rendered = renderWorkspaceManifest manifest+             in case parseWorkspaceManifest "<generated>" rendered of+                  Left err -> counterexample (T.unpack err) False+                  Right reparsed ->+                    counterexample (T.unpack rendered) $+                      reparsed == manifest && renderWorkspaceManifest reparsed == rendered+      it "recognizes a workspace manifest by extension, case-insensitively" $ do+        map+          isWorkspacePath+          [ "service.keiro-workspace",+            "a/b/Service.KEIRO-Workspace",+            "service.keiro",+            ".keiro-workspace",+            "keiro-workspace"+          ]+          `shouldBe` [True, True, False, False, False]+    describe "manifest refusals" $ do+      let rejects description source expected =+            it description $ case parseWorkspaceManifest "<manifest>" source of+              Right _ -> expectationFailure ("expected a refusal, got a manifest for:\n" <> T.unpack source)+              Left err -> T.unpack err `shouldContain` expected+      rejects+        "an empty manifest"+        "# only a comment\n"+        "must begin with a 'service <name>' clause"+      rejects+        "a manifest with no service clause"+        "spec domain/a.keiro\n"+        "first clause of a workspace manifest must be 'service <name>'"+      rejects+        "a manifest whose first clause is not service"+        "module Demo\nservice demo\nspec domain/a.keiro\n"+        "first clause of a workspace manifest must be 'service <name>'"+      rejects+        "a duplicate service clause"+        "service demo\nservice demo\nspec domain/a.keiro\n"+        "duplicate 'service' clause"+      rejects+        "a duplicate module clause"+        "service demo\nmodule Demo\nmodule Demo\nspec domain/a.keiro\n"+        "duplicate 'module' clause"+      rejects+        "a duplicate runtime-package clause"+        "service demo\nruntime-package demo-core\nruntime-package demo-api\nspec domain/a.keiro\n"+        "duplicate 'runtime-package' clause"+      it "locates a malformed runtime-package at its manifest line" $ case parseWorkspaceManifest "<manifest>" "service demo\nspec domain/a.keiro\nruntime-package demo_core\n" of+        Right _ -> expectationFailure "expected a malformed runtime package refusal"+        Left err -> do+          T.unpack err `shouldContain` "<manifest>:3:1"+          T.unpack err `shouldContain` "does not follow Cabal package-name grammar"+      rejects+        "a duplicate layout clause"+        "service demo\nlayout prefixed\nlayout prefixed\nspec domain/a.keiro\n"+        "duplicate 'layout' clause"+      rejects+        "a manifest with no members"+        "service demo\nmodule Demo\n"+        "must list at least one 'spec <path>.keiro' member"+      rejects+        "the same member listed twice"+        "service demo\nspec domain/a.keiro\nspec ./domain/a.keiro\n"+        "duplicate workspace member 'domain/a.keiro'"+      rejects+        "two members that differ only by case"+        "service demo\nspec domain/a.keiro\nspec domain/A.keiro\n"+        "differ only by case"+      rejects+        "an absolute member path"+        "service demo\nspec /etc/a.keiro\n"+        "must be relative, not absolute"+      rejects+        "a member path escaping the manifest directory"+        "service demo\nspec ../escape.keiro\n"+        "must not contain '..' segments"+      rejects+        "a member that is not a .keiro spec"+        "service demo\nspec domain/a.txt\n"+        "must name a .keiro spec"+      rejects+        "a manifest listing another manifest"+        "service demo\nspec domain/other.keiro-workspace\n"+        "must name a .keiro spec"+    describe "line relocation" $ do+      it "shifts every location the AST carries, and only the locations" $ do+        spec <- specOf "test/fixtures/reservation.keiro"+        let shifted = relocateLocs (+ 1000) spec+        collectLocs spec `shouldSatisfy` (not . null)+        collectLocs shifted `shouldBe` map (+ 1000) (collectLocs spec)+        -- Loc's Eq deliberately ignores the line, so relocation cannot+        -- change any equality-based behavior anywhere downstream.+        shifted `shouldBe` spec+      it "leaves the placeholder location alone so it never lands inside a member range" $ do+        spec <- specOf "test/fixtures/reservation.keiro"+        let blanked = relocateLocs (const 0) spec+            reshifted = relocateLocs (\n -> if n <= 0 then n else n + 500) blanked+        collectLocs reshifted `shouldBe` map (const 0) (collectLocs spec)+    describe "composition" $ do+      it "resolves cross-file ids, enums, mapped types, and read-model feeds" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        (.service) workspace `shouldBe` "demo-project"+        workspace.context `shouldBe` "demo-project"+        (.moduleRoot) workspace `shouldBe` Just "Demo.Modules.Project"+        (.layout) workspace `shouldBe` Just CollocatedLeaf+        map (.path) ((.members) workspace)+          `shouldBe` [ "domain/project-artifact.keiro",+                       "domain/project.keiro",+                       "domain/shared.keiro"+                     ]+        -- Every member is individually incomplete; together they check.+        checkWorkspace workspace `shouldBe` []+      it "records which member owns each shared declaration and node" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        let ownershipIndex = workspace.ownership+        fmap fst (declarationOwner ownershipIndex "id" "ProjectId")+          `shouldBe` Just "domain/shared.keiro"+        fmap fst (declarationOwner ownershipIndex "enum" "ProjectPhase")+          `shouldBe` Just "domain/shared.keiro"+        fmap fst (declarationOwner ownershipIndex "rule" "phaseIsTerminal")+          `shouldBe` Just "domain/shared.keiro"+        fmap fst (declarationOwner ownershipIndex "mapped" "ProjectSummary")+          `shouldBe` Just "domain/shared.keiro"+        fmap fst (nodeOwner ownershipIndex "aggregate" "Project")+          `shouldBe` Just "domain/project.keiro"+        fmap fst (nodeOwner ownershipIndex "aggregate" "ProjectArtifact")+          `shouldBe` Just "domain/project-artifact.keiro"+        fmap fst (nodeOwner ownershipIndex "readmodel" "project_activity")+          `shouldBe` Just "domain/project-artifact.keiro"+      it "maps every merged line back to the member that wrote it" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        let bases = [((.path) m, (.lineBase) m, (.lineCount) m) | m <- (.members) workspace]+        -- Ranges are disjoint and contiguous from zero.+        map (\(_, base, _) -> base) bases `shouldBe` scanl (+) 0 (init [c | (_, _, c) <- bases])+        sequence_+          [ resolveWorkspaceLine workspace (base + offset) `shouldBe` Just (path, offset)+          | (path, base, memberLines) <- bases,+            offset <- [1, memberLines]+          ]+        resolveWorkspaceLine workspace 0 `shouldBe` Nothing+      it "is insensitive to the order members are listed in" $ do+        canonical <- shouldComposeWorkspace canonicalWorkspacePath+        reordered <- shouldComposeWorkspace reorderedWorkspacePath+        workspaceWithManifestPath canonical.manifestPath reordered `shouldBe` canonical+      describe "workspace source provenance" $ do+        it "keeps a later member's exact points stable when an earlier member gains source lines" $ do+          let manifestText = T.unlines ["service provenance", "spec a.keiro", "spec b.keiro"]+              aSource =+                T.unlines+                  [ "context provenance",+                    "aggregate Alpha",+                    "  regs",+                    "  states Empty",+                    "  command Ping {}",+                    "  event Pinged {}",+                    "  Empty -- Ping --> emit Pinged; goto Empty"+                  ]+              bSource =+                T.unlines+                  [ "context provenance",+                    "aggregate Beta",+                    "  regs",+                    "  states Empty",+                    "  command Ping {}",+                    "  event Pinged {}",+                    "  Empty -- Ping --> emit Pinged; goto Empty"+                  ]+              sourceWith alpha =+                ContentSource+                  { csRead = \case+                      "service.keiro-workspace" -> pure (Right manifestText)+                      "a.keiro" -> pure (Right alpha)+                      "b.keiro" -> pure (Right bSource)+                      path -> pure (Left ("unexpected path " <> T.pack path))+                  }+              loadWith alpha = do+                loaded <- loadWorkspace (sourceWith alpha) "service.keiro-workspace"+                case loaded of+                  Left workspaceFailure -> expectationFailure (show workspaceFailure) >> fail "unreachable"+                  Right value -> pure value+              betaLocation workspace =+                lookupSourceSpan+                  (AggregateTransitionSubject "Beta" (TransitionOrdinal 0))+                  ((.sourceIndex) workspace)+              betaBase workspace = (.lineBase) <$> find ((== "b.keiro") . (.path)) ((.members) workspace)+          originalWorkspace <- loadWith aSource+          shiftedWorkspace <- loadWith ("# inserted before Alpha\n" <> aSource)+          betaLocation shiftedWorkspace `shouldBe` betaLocation originalWorkspace+          betaBase shiftedWorkspace `shouldBe` ((+ 1) <$> betaBase originalWorkspace)+          case betaLocation originalWorkspace of+            Just (ExactSourcePosition, SourceSpan {source, start = SourcePoint {line, column}}) ->+              (source, line, column) `shouldBe` ("b.keiro", 7, 3)+            other -> expectationFailure ("expected exact Beta transition location, got " <> show other)++          document <- case parseSourceDocument "b.keiro" bSource of+            Left parseFailure -> expectationFailure (show parseFailure) >> fail "unreachable"+            Right value -> pure value+          exactOneMember <- case oneMemberParsedDocumentWorkspace "b.keiro" document of+            Left sourceIndexFailure -> expectationFailure (show sourceIndexFailure) >> fail "unreachable"+            Right value -> pure value+          betaLocation exactOneMember `shouldBe` betaLocation originalWorkspace+          let ParsedSourceDocument {parsedSource} = document+              compatibility = oneMemberParsedWorkspace "b.keiro" parsedSource+          fmap fst (betaLocation compatibility) `shouldBe` Just CompatibilityLineOnly+      it "checks a single .keiro file as a one-member workspace, diagnostic for diagnostic" $ do+        let fixtures =+              [ "test/fixtures/reservation.keiro",+                "test/fixtures/consumer-types.keiro",+                "test/fixtures/aggregate-bad-refs.keiro",+                "test/fixtures/readmodel.keiro"+              ]+        forM_ fixtures $ \path -> do+          spec <- specOf path+          let workspace = oneMemberWorkspace path spec+              viaWorkspace = map (renderWorkspaceDiagnostic path) (checkWorkspace workspace)+              direct = map (renderDiagnostic path) (validateSpec spec)+          viaWorkspace `shouldBe` direct+        -- At least one of those fixtures must actually produce errors,+        -- or the equivalence claim is vacuous.+        badRefs <- specOf "test/fixtures/aggregate-bad-refs.keiro"+        checkWorkspace (oneMemberWorkspace "test/fixtures/aggregate-bad-refs.keiro" badRefs)+          `shouldSatisfy` any ((== Error) . (.severity))+    describe "composition refusals" $ do+      let refusesWith path expectedCode expectedFiles = do+            diagnostics <- shouldRefuseWorkspace path+            map (.code) (NE.toList diagnostics) `shouldContain` [expectedCode]+            let cited =+                  [ (.file) location+                  | diagnostic <- NE.toList diagnostics,+                    (.code) diagnostic == expectedCode,+                    location <- NE.toList ((.locations) diagnostic)+                  ]+            sort (nubOrd cited) `shouldBe` sort expectedFiles+      it "refuses members that declare different contexts, citing every context clause" $+        refusesWith+          "test/fixtures/workspace-context-mismatch/service.keiro-workspace"+          WorkspaceContextMismatch+          [WorkspaceMemberFile "domain/a.keiro", WorkspaceMemberFile "domain/b.keiro"]+      it "refuses a member layout clause that contradicts the manifest authority" $+        refusesWith+          "test/fixtures/workspace-authority-conflict/service.keiro-workspace"+          WorkspaceAuthorityConflict+          [WorkspaceManifestFile, WorkspaceMemberFile "domain/b.keiro"]+      it "refuses a textually identical shared declaration owned by two members" $+        refusesWith+          "test/fixtures/workspace-dup-decl/service.keiro-workspace"+          WorkspaceDuplicateDeclaration+          [WorkspaceMemberFile "domain/project.keiro", WorkspaceMemberFile "domain/shared.keiro"]+      it "refuses one aggregate defined in two members" $+        refusesWith+          "test/fixtures/workspace-dup-node/service.keiro-workspace"+          WorkspaceDuplicateNodeName+          [WorkspaceMemberFile "domain/a.keiro", WorkspaceMemberFile "domain/b.keiro"]+      it "refuses generated paths that collide across members under case folding" $+        refusesWith+          "test/fixtures/workspace-path-collision/service.keiro-workspace"+          WorkspacePathCollision+          [WorkspaceMemberFile "domain/a.keiro", WorkspaceMemberFile "domain/b.keiro"]+      it "reports a listed member that is missing from disk" $+        refusesWith+          "test/fixtures/workspace-missing-member/service.keiro-workspace"+          WorkspaceMemberUnreadable+          [WorkspaceManifestFile]+      it "reports a member that does not parse" $+        refusesWith+          "test/fixtures/workspace-member-parse-failed/service.keiro-workspace"+          WorkspaceMemberParseFailed+          [WorkspaceManifestFile]+      it "surfaces a cross-file unresolved reference through the merged validator" $ do+        workspace <- shouldComposeWorkspace "test/fixtures/workspace-unresolved/service.keiro-workspace"+        let errors = [d | d <- checkWorkspace workspace, (.severity) d == Error]+        map (.code) errors `shouldContain` [GuardAtomOutOfScope]+        [(.file) location | d <- errors, location <- NE.toList ((.locations) d)]+          `shouldContain` [WorkspaceMemberFile "domain/project.keiro"]+    describe "multi-file diagnostic rendering" $ do+      it "puts the primary location in the established shape and every other file on a note line" $ do+        diagnostics <- shouldRefuseWorkspace "test/fixtures/workspace-dup-decl/service.keiro-workspace"+        let manifest = "keiro-dsl/test/fixtures/workspace-dup-decl/service.keiro-workspace"+        map (renderWorkspaceDiagnostic manifest) (NE.toList diagnostics)+          `shouldBe` [ T.intercalate+                         "\n"+                         [ "keiro-dsl/test/fixtures/workspace-dup-decl/domain/project.keiro:4: error[WorkspaceDuplicateDeclaration]: duplicate declaration 'ProjectId': a shared declaration has exactly one owning member (identical duplicates do not merge)",+                           "  keiro-dsl/test/fixtures/workspace-dup-decl/domain/shared.keiro:4: note: also declared here, as id 'ProjectId'"+                         ]+                     ]+    describe "whole-service check through the CLI" $ do+      it "prints OK and exits zero for the composed fixture workspace" $ do+        (exitCode, out, err) <- runKeiroDsl ["check", canonicalWorkspacePath]+        unless (exitCode == ExitSuccess) (expectationFailure (out <> err))+        lines out `shouldBe` ["OK"]+      it "exits non-zero and names every involved file for a cross-file refusal" $ do+        (exitCode, _, err) <-+          runKeiroDsl ["check", "test/fixtures/workspace-dup-decl/service.keiro-workspace"]+        exitCode `shouldBe` ExitFailure 1+        err `shouldContain` "error[WorkspaceDuplicateDeclaration]"+        err `shouldContain` "workspace-dup-decl/domain/project.keiro:4"+        err `shouldContain` "workspace-dup-decl/domain/shared.keiro:4"+      it "attributes a merged-graph validation error to the member that wrote it" $ do+        (exitCode, _, err) <-+          runKeiroDsl ["check", "test/fixtures/workspace-unresolved/service.keiro-workspace"]+        exitCode `shouldBe` ExitFailure 1+        err `shouldContain` "workspace-unresolved/domain/project.keiro:12: error[GuardAtomOutOfScope]"+      it "produces byte-identical output for a manifest whose members are listed in reverse" $ do+        (canonicalCode, canonicalOut, _) <- runKeiroDsl ["check", canonicalWorkspacePath, "--emit"]+        (reorderedCode, reorderedOut, _) <- runKeiroDsl ["check", reorderedWorkspacePath, "--emit"]+        canonicalCode `shouldBe` ExitSuccess+        reorderedCode `shouldBe` ExitSuccess+        reorderedOut `shouldBe` canonicalOut+        (_, canonicalParse, _) <- runKeiroDsl ["parse", canonicalWorkspacePath]+        (_, reorderedParse, _) <- runKeiroDsl ["parse", reorderedWorkspacePath]+        reorderedParse `shouldBe` canonicalParse+      it "keeps the single-file path working, byte for byte" $ do+        (exitCode, out, err) <- runKeiroDsl ["check", "test/fixtures/reservation.keiro"]+        unless (exitCode == ExitSuccess) (expectationFailure (out <> err))+        lines out `shouldBe` ["OK"]+      it "explains bindings and reports coverage against the merged graph" $ do+        (bindingsCode, bindingsOut, _) <-+          runKeiroDsl ["check", canonicalWorkspacePath, "--explain-bindings"]+        bindingsCode `shouldBe` ExitSuccess+        bindingsOut `shouldContain` "binding obligations for context demo-project"+        -- The obligation's use sites span both aggregate members, which+        -- is only possible because the graph was resolved once, merged.+        bindingsOut `shouldContain` "Project register summary : ProjectSummary"+        bindingsOut `shouldContain` "ProjectArtifact command RecordArtifact .artifactSummary : ProjectSummary"+        withTempDirectory "keiro-dsl-workspace-coverage" $ \out -> do+          let reportPath = out </> "coverage.json"+          (coverageCode, coverageOut, _) <-+            runKeiroDsl ["check", canonicalWorkspacePath, "--coverage-report", reportPath]+          coverageCode `shouldBe` ExitSuccess+          coverageOut `shouldContain` "structural/opaque boundaries (reporting only)"+          report <- Aeson.eitherDecodeFileStrict reportPath+          case report of+            Left err -> expectationFailure err+            Right value -> coverageSpecPath value `shouldBe` Just (T.pack canonicalWorkspacePath)++  describe "workspace diff revision loading (EP-155 M1)" $ do+    it "composes added, removed, and renamed members through an in-memory content source" $ do+      project <- readTestText "test/fixtures/workspace/domain/project.keiro"+      artifact <- readTestText "test/fixtures/workspace/domain/project-artifact.keiro"+      shared <- readTestText "test/fixtures/workspace/domain/shared.keiro"+      let extra = "language keiro-dsl 4\ncontext demo-project\n\nid ExtraId prefix=extra\n"+          manifest members =+            T.unlines+              ( ["service demo-project", "module Demo.Modules.Project", "layout collocated"]+                  <> ["spec " <> T.pack member | member <- members]+              )+          baseFiles =+            Map.fromList+              [ ("domain/project.keiro", project),+                ("domain/project-artifact.keiro", artifact),+                ("domain/shared.keiro", shared)+              ]+          loadFrom members files =+            loadWorkspace+              (memoryContentSource (Map.insert "service.keiro-workspace" (manifest members) files))+              "service.keiro-workspace"+          baseMembers = ["domain/project.keiro", "domain/project-artifact.keiro", "domain/shared.keiro"]+          expectLoaded result = case result of+            Left failure -> expectationFailure (show failure) >> error "unreachable"+            Right workspace -> pure workspace++      oldAdded <- loadFrom baseMembers baseFiles >>= expectLoaded+      newAdded <-+        loadFrom+          (baseMembers <> ["domain/extra.keiro"])+          (Map.insert "domain/extra.keiro" extra baseFiles)+          >>= expectLoaded+      map changeCode (diffSpecs ((.mergedSpec) oldAdded) ((.mergedSpec) newAdded))+        `shouldContain` [DeclarationAdded]++      oldRemoved <- loadFrom baseMembers baseFiles >>= expectLoaded+      newRemoved <-+        loadFrom+          ["domain/project.keiro", "domain/shared.keiro"]+          (Map.delete "domain/project-artifact.keiro" baseFiles)+          >>= expectLoaded+      map changeCode (diffSpecs ((.mergedSpec) oldRemoved) ((.mergedSpec) newRemoved))+        `shouldContain` [EvtRemovedNotDeprecated]++      oldRenamed <- loadFrom baseMembers baseFiles >>= expectLoaded+      let renamedMembers = ["domain/project-renamed.keiro", "domain/project-artifact.keiro", "domain/shared.keiro"]+          renamedFiles = Map.insert "domain/project-renamed.keiro" project (Map.delete "domain/project.keiro" baseFiles)+      newRenamed <- loadFrom renamedMembers renamedFiles >>= expectLoaded+      diffSpecs ((.mergedSpec) oldRenamed) ((.mergedSpec) newRenamed) `shouldBe` []++  describe "workspace diff ownership and unified reports (EP-155 M2)" $ do+    it "classifies shared declarations at use sites across every member with owned citations" $ do+      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"+      new <- shouldComposeWorkspace "test/fixtures/workspace-diff-new/service.keiro-workspace"+      let changes = diffWorkspaces old new+          enumChanges = filter ((== EnumCtorAdded) . changeCode . (.change)) changes+          mappedChanges = filter ((== MappedFieldTypeChanged) . changeCode . (.change)) changes+          citedFiles workspaceChanges =+            [ (.file) site+            | change <- workspaceChanges,+              (_, Just site) <- (.useSites) change+            ]+      enumChanges `shouldSatisfy` (not . null)+      mappedChanges `shouldSatisfy` (not . null)+      let enumWireChanges =+            [ underlyingChange+            | workspaceChange <- enumChanges,+              let underlyingChange = workspaceChange.change,+              OldBinaryReadNewEvents `elem` breakingSurfaces underlyingChange+            ]+      enumWireChanges `shouldSatisfy` (not . null)+      enumWireChanges `shouldSatisfy` all (not . gatedBreaking defaultGate)+      enumWireChanges `shouldSatisfy` all (gatedBreaking (gateWith [OldBinaryReadNewEvents]))+      map (fmap (.file) . (.declarationSite)) (enumChanges <> mappedChanges)+        `shouldSatisfy` all (== Just "domain/shared.keiro")+      citedFiles enumChanges `shouldContain` ["domain/order.keiro", "domain/shipment.keiro"]+      citedFiles mappedChanges `shouldContain` ["domain/order.keiro", "domain/shipment.keiro"]+      let rendered = T.intercalate "\n" (map renderWorkspaceFinding (enumChanges <> mappedChanges))+      rendered `shouldSatisfy` T.isInfixOf "    declared: domain/shared.keiro:4"+      rendered `shouldSatisfy` T.isInfixOf "    use-site: Order"+      rendered `shouldSatisfy` T.isInfixOf "(domain/order.keiro:"+      rendered `shouldSatisfy` T.isInfixOf "(domain/shipment.keiro:"+      assertMatchesGolden "test/fixtures/workspace-diff-new/workspace.diff.golden" (T.unlines (map renderWorkspaceFinding changes))++    it "emits one additive version-1 report with workspace provenance" $ do+      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"+      new <- shouldComposeWorkspace "test/fixtures/workspace-diff-new/service.keiro-workspace"+      let changes = diffWorkspaces old new+          meta =+            WorkspaceMeta+              { identity = (.service) new,+                manifest = "service.keiro-workspace",+                since = "HEAD",+                membersOld = map (.path) ((.members) old),+                membersNew = map (.path) ((.members) new),+                adoptionBaseline = False+              }+      case Aeson.toJSON (workspaceDiffReport meta defaultGate changes) of+        Aeson.Object report -> do+          KeyMap.lookup "schema" report `shouldBe` Just (Aeson.String "keiro-dsl/diff-report/1")+          case KeyMap.lookup "workspace" report of+            Just (Aeson.Object workspace) -> do+              KeyMap.lookup "identity" workspace `shouldBe` Just (Aeson.String "workspace-diff")+              KeyMap.lookup "adoptionBaseline" workspace `shouldBe` Just (Aeson.Bool False)+            other -> expectationFailure ("missing workspace report metadata: " <> show other)+          case KeyMap.lookup "findings" report of+            Just (Aeson.Array findings) -> do+              findings `shouldSatisfy` (not . null)+              let objects = [finding | Aeson.Object finding <- toList findings]+              objects `shouldSatisfy` any (KeyMap.member "declaration")+              objects `shouldSatisfy` any (KeyMap.member "useSites")+            other -> expectationFailure ("missing workspace findings: " <> show other)+        other -> expectationFailure ("workspace report was not an object: " <> show other)++    it "computes one replay-impact value over both aggregates" $ do+      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"+      new <- shouldComposeWorkspace "test/fixtures/workspace-diff-new/service.keiro-workspace"+      case replayImpactSpecs ((.mergedSpec) old) ((.mergedSpec) new) of+        ReplayAffected affected -> Map.keysSet affected `shouldBe` Set.fromList ["Order", "Shipment"]+        ReplayNeutral -> expectationFailure "shared mapped evolution unexpectedly reported replay-neutral"++  describe "workspace ownership and authority changes (EP-155 M3)" $ do+    it "reports an unchanged aggregate move once without wire evolution" $ do+      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"+      moved <- shouldComposeWorkspace "test/fixtures/workspace-diff-moved/service.keiro-workspace"+      let changes = diffWorkspaces old moved+      map (changeCode . (.change)) changes `shouldBe` [OwnershipMoved]+      forM_ changes $ \workspaceMove -> do+        let move = (.change) workspaceMove+        move `shouldSatisfy` isAdvisory+        move `shouldSatisfy` (not . gatedBreaking defaultGate)+        move `shouldSatisfy` (not . gatedBreaking (gateWith [minBound .. maxBound]))+        deriveLabel defaultGate ((workspaceChangeKind move).vector) `shouldBe` LabelAdvisory+        remediationFor ((workspaceChangeKind move).context) OwnershipMoved+          `shouldBe` (RemedyRescaffoldWorkspace :| [])+        renderWorkspaceFinding workspaceMove+          `shouldSatisfy` T.isInfixOf "declaration moved domain/shipment.keiro -> domain/order.keiro"++    it "treats a member rename as the same owner-map change" $ do+      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"+      let ownershipIndex = old.ownership+          renamed =+            workspaceWithOwnership+              (OwnershipIndex ownershipIndex.declarations (Map.adjust (\(_, loc) -> ("domain/shipping.keiro", loc)) ("aggregate", "Shipment") ownershipIndex.nodes))+              old+          moves = filter ((== OwnershipMoved) . changeCode . (.change)) (diffWorkspaces old renamed)+      length moves `shouldBe` 1+      forM_ moves $ \move ->+        renderWorkspaceFinding move `shouldSatisfy` T.isInfixOf "domain/shipment.keiro -> domain/shipping.keiro"++    it "reports ownership motion beside an independently classified wire edit" $ do+      old <- shouldComposeWorkspace "test/fixtures/workspace-diff-old/service.keiro-workspace"+      edited <- shouldComposeWorkspace "test/fixtures/workspace-diff-new/service.keiro-workspace"+      let ownershipIndex = edited.ownership+          movedAndEdited =+            workspaceWithOwnership+              (OwnershipIndex ownershipIndex.declarations (Map.adjust (\(_, loc) -> ("domain/order.keiro", loc)) ("aggregate", "Shipment") ownershipIndex.nodes))+              edited+          codes = map (changeCode . (.change)) (diffWorkspaces old movedAndEdited)+      codes `shouldContain` [OwnershipMoved]+      codes `shouldContain` [MappedFieldTypeChanged]++    it "reports context authority separately from derived read-model identity breaks" $ do+      old <- shouldComposeWorkspace canonicalWorkspacePath+      let newContext = "demo-project-renamed"+          renamed =+            workspaceWithContextAndMergedSpec newContext (specWithContext newContext old.mergedSpec) old+          changes = diffWorkspaces old renamed+          codes = map (changeCode . (.change)) changes+      codes `shouldContain` [WorkspaceAuthorityChanged]+      codes `shouldContain` [DerivedIdentityChanged]+      map (.change) changes `shouldSatisfy` any (gatedBreaking defaultGate)++    it "keeps service, module-root, and layout authority advisories non-blocking" $ do+      old <- shouldComposeWorkspace canonicalWorkspacePath+      let changed = workspaceWithAuthority "demo-project-renamed" (Just "Demo.Modules.Renamed") (Just GeneratedPrefix) old+          authority = filter ((== WorkspaceAuthorityChanged) . changeCode . (.change)) (diffWorkspaces old changed)+      length authority `shouldBe` 3+      forM_ (map (.change) authority) $ \change -> do+        deriveLabel defaultGate ((workspaceChangeKind change).vector) `shouldBe` LabelAdvisory+        change `shouldSatisfy` (not . gatedBreaking (gateWith [minBound .. maxBound]))+        remediationFor ((workspaceChangeKind change).context) WorkspaceAuthorityChanged+          `shouldBe` (RemedyRescaffoldWorkspace :| [RemedyRecompileConsumers])++  describe "workspace scaffold (EP-154)" $ do+    describe "workspace record" $ do+      it "round-trips modules, owners, members, mappings, obligations, and adoptions" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        let record = sampleWorkspaceRecord workspace+            rendered = renderWorkspaceRecord record+        parseWorkspaceRecord rendered `shouldBe` Just record+        -- The header pins the schema: a v1 context-keyed record and a+        -- workspace record can never be read as each other.+        T.lines rendered `shouldSatisfy` \case+          header : _ -> header == "keiro-dsl workspace scaffold record v1"+          [] -> False+        parseRecord rendered `shouldBe` Nothing+        parseWorkspaceRecord (T.replace "record v1" "record v2" rendered) `shouldBe` Nothing+      it "ignores unknown rows and unknown JSON keys, and keeps context-level rows ownerless" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        let record = sampleWorkspaceRecord workspace+            rendered = renderWorkspaceRecord record+        parseWorkspaceRecord (T.replace "service: " "future-row: retained\nservice: " rendered)+          `shouldBe` Just record+        parseWorkspaceRecord (T.replace "\"kind\":\"generated\"" "\"kind\":\"generated\",\"future\":1" rendered)+          `shouldBe` Just record+        [row | row <- (.modules) record, (.owner) row == Nothing]+          `shouldSatisfy` (not . null)+      it "rejects absent stable language rows and partial, duplicate, malformed, or inconsistent contracts" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        let record = sampleWorkspaceRecord workspace+            rendered = renderWorkspaceRecord record+            sourceRows = filter ("source-language " `T.isPrefixOf`) (T.lines rendered)+            withoutSourceRows = T.unlines (filter (not . T.isPrefixOf "source-language ") (T.lines rendered))+            semanticRows = filter ("semantic-contract " `T.isPrefixOf`) (T.lines rendered)+            withoutSemanticRows = T.unlines (filter (not . T.isPrefixOf "semantic-contract ") (T.lines rendered))+        parseWorkspaceRecord withoutSourceRows `shouldBe` Nothing+        case sourceRows of+          firstRow : secondRow : _ -> do+            parseWorkspaceRecord (T.unlines (filter (/= secondRow) (T.lines rendered))) `shouldBe` Nothing+            parseWorkspaceRecord (T.replace firstRow (firstRow <> "\n" <> firstRow) rendered) `shouldBe` Nothing+            parseWorkspaceRecord (T.replace firstRow "source-language {malformed}" rendered) `shouldBe` Nothing+          _ -> expectationFailure "expected multiple workspace source-language rows"+        parseWorkspaceRecord withoutSemanticRows `shouldBe` Just record+        case semanticRows of+          [semanticRow] -> do+            parseWorkspaceRecord (T.replace semanticRow (semanticRow <> "\n" <> semanticRow) rendered) `shouldBe` Nothing+            parseWorkspaceRecord (T.replace semanticRow "semantic-contract {malformed}" rendered) `shouldBe` Nothing+            parseWorkspaceRecord (T.replace "\"languageVersion\":4" "\"languageVersion\":3" rendered) `shouldBe` Nothing+          _ -> expectationFailure "expected one workspace semantic-contract row"+      it "rejects unsafe module, owner, member, and adoption paths" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        let rendered = renderWorkspaceRecord (sampleWorkspaceRecord workspace)+            corrupt from to = parseWorkspaceRecord (T.replace from to rendered)+        corrupt "member domain/shared.keiro" "member /etc/passwd" `shouldBe` Nothing+        corrupt "member domain/shared.keiro" "member ../escape.keiro" `shouldBe` Nothing+        corrupt "\"owner\":\"domain/shared.keiro\"" "\"owner\":\"../shared.keiro\"" `shouldBe` Nothing+        corrupt "\"path\":\"claimed/One.hs\"" "\"path\":\"/tmp/One.hs\"" `shouldBe` Nothing+      it "keys context and workspace history in structurally distinct explicit slots" $ do+        workspaceRecordFileName "demo-project"+          `shouldBe` workspaceLedgerFileName "demo-project"+        workspaceManifestFileName "demo-project"+          `shouldBe` workspaceCabalFragmentFileName "demo-project"+        workspaceRecordFileName "demo-project" `shouldNotBe` recordFileName "demo-project"+        contextLedgerFileName "workspace"+          `shouldNotBe` workspaceLedgerFileName "workspace"+        supersededByLine "demo-project"+          `shouldBe` "superseded-by: keiro-dsl-ledger.workspace.demo-project.txt"++    describe "workspace plan" $ do+      it "emits the context-level facade and replay-audit exactly once from the merged graph" $ do+        plan <- shouldPlanWorkspace canonicalWorkspacePath+        let modules = map fst (plan.modules)+            facades = [m | m <- modules, "StructuralProjections.hs" `isSuffixOfPath` m]+            audits = [m | m <- modules, "ReplayAudit.hs" `isSuffixOfPath` m]+            sourceMaps = [m | m <- modules, "BehaviorSourceMap.hs" `isSuffixOfPath` m]+            shapes = [m | m <- modules, "Structural/Shape/ProjectSummary.hs" `isSuffixOfPath` m]+        length facades `shouldBe` 1+        length audits `shouldBe` 1+        length sourceMaps `shouldBe` 1+        length shapes `shouldBe` 1+        -- The audit assembles aggregates owned by two different member+        -- files, which is only possible from one merged graph.+        forM_ audits $ \audit -> do+          (.text) audit `shouldSatisfy` T.isInfixOf "Project.projectEventStream"+          (.text) audit `shouldSatisfy` T.isInfixOf "ProjectArtifact.projectArtifactEventStream"+      it "gives every generated ID and enum one context owner and imports only aggregate uses" $ do+        plan <- shouldPlanWorkspace canonicalWorkspacePath+        let ctx = plan.context+            modules = map fst (plan.modules)+            nominalModules = [m | m <- modules, (.path) m == T.unpack (T.replace "." "/" (generatedNominalModule ctx) <> ".hs")]+            internalNominalModules = [m | m <- modules, (.path) m == T.unpack (T.replace "." "/" (generatedNominalModule ctx) <> "/Internal.hs")]+            domainFor suffix = case [m | m <- modules, suffix `isSuffixOfPath` m] of+              [m] -> pure m+              found -> expectationFailure ("expected one domain ending in " <> suffix <> ", got " <> show (map (.path) found)) >> fail "unreachable"+        ownerModule <- case nominalModules of+          [m] -> pure m+          found -> expectationFailure ("expected one generated nominal owner, got " <> show (map (.path) found)) >> fail "unreachable"+        internalOwnerModule <- case internalNominalModules of+          [m] -> pure m+          found -> expectationFailure ("expected one generated internal nominal owner, got " <> show (map (.path) found)) >> fail "unreachable"+        let nominalText = (.text) ownerModule+            internalNominalText = (.text) internalOwnerModule+        T.count "newtype ProjectId" nominalText `shouldBe` 0+        T.count "newtype ProjectId" internalNominalText `shouldBe` 1+        T.count "data ProjectPhase =" nominalText `shouldBe` 1+        T.count "data WorkspaceVisibility =" nominalText `shouldBe` 1+        projectDomain <- domainFor "Project/Generated/Domain.hs"+        artifactDomain <- domainFor "ProjectArtifact/Generated/Domain.hs"+        forM_ [projectDomain, artifactDomain] $ \domain -> do+          (.text) domain `shouldSatisfy` (not . T.isInfixOf "newtype ProjectId")+          (.text) domain `shouldSatisfy` (not . T.isInfixOf "data ProjectPhase")+          (.text) domain `shouldSatisfy` T.isInfixOf (generatedNominalModule ctx <> " (ProjectId, parseProjectId, ProjectPhase (..))")+          (.text) domain `shouldSatisfy` (not . T.isInfixOf "WorkspaceVisibility")+        -- Preserve the members' declared language contract. The active language-5+        -- candidate must not silently restamp an existing language-4 workspace.+        singleFileModules <- case planIndexedServiceScaffold ((.sourceIndex) ((.workspace) plan)) ctx (plan.checkedService) of+          Left refusals -> expectationFailure (show refusals) >> fail "unreachable"+          Right values -> pure values+        let withoutOrigin m = ((.path) m, (.text) m, (.kind) m)+        map withoutOrigin singleFileModules `shouldBe` map withoutOrigin modules+        owners <- case planNominalGeneration ctx ((.mergedSpec) ((.workspace) plan)) of+          Left errors -> expectationFailure (show errors) >> fail "unreachable"+          Right values -> pure values+        map ((.name) . (.declaration)) owners+          `shouldBe` ["ProjectId", "ProjectPhase", "WorkspaceVisibility"]+        case [owner | owner <- owners, (.name) ((.declaration) owner) == "ProjectId"] of+          [owner] -> do+            (.moduleName) owner `shouldBe` generatedNominalModule ctx+            Set.fromList [NominalUseSite "Project" RegisterUse, NominalUseSite "ProjectArtifact" EventFieldUse]+              `shouldSatisfy` (`Set.isSubsetOf` (.useSites) owner)+          found -> expectationFailure ("expected one ProjectId owner, got " <> show (length found))+      it "attributes every module to its owning member and leaves shared ones context-level" $ do+        plan <- shouldPlanWorkspace canonicalWorkspacePath+        let memberPaths = map (.path) ((.members) ((.workspace) plan))+            ownerOf suffix =+              case [provenance | (m, provenance) <- (.modules) plan, suffix `isSuffixOfPath` m] of+                [provenance] -> Just provenance+                _ -> Nothing+        ownerOf "StructuralProjections.hs" `shouldBe` Just ContextLevel+        ownerOf "Generated/Nominals.hs" `shouldBe` Just ContextLevel+        ownerOf "ReplayAudit.hs" `shouldBe` Just ContextLevel+        ownerOf "Structural/Shape/ProjectSummary.hs"+          `shouldBe` Just (MemberOwned "domain/shared.keiro")+        ownerOf "Project/Generated/Domain.hs"+          `shouldBe` Just (MemberOwned "domain/project.keiro")+        ownerOf "ProjectArtifact/Generated/Domain.hs"+          `shouldBe` Just (MemberOwned "domain/project-artifact.keiro")+        ownerOf "ProjectActivity/Generated/ReadModel.hs"+          `shouldBe` Just (MemberOwned "domain/project-artifact.keiro")+        -- No module may claim an owner that is not a member of the+        -- workspace: the record's owner column has to stay resolvable.+        map (provenanceOwner . snd) ((.modules) plan)+          `shouldSatisfy` all (maybe True (`elem` memberPaths))+      it "keeps the compiled workspace nominal conformance tree byte-current" $ do+        workspace <- shouldComposeWorkspace "test/fixtures/workspace-nominals/service.keiro-workspace"+        plan <- shouldPlanWorkspaceSpec workspace+        let compiledPaths =+              [ "Generated/WorkspaceNominalProof/BehaviorSourceMap.hs",+                "Generated/WorkspaceNominalProof/Nominals.hs",+                "Generated/WorkspaceNominalProof/Project/Domain.hs",+                "Generated/WorkspaceNominalProof/Project/Codec.hs",+                "Generated/WorkspaceNominalProof/Project/Transducer.hs",+                "Generated/WorkspaceNominalProof/Project/BehaviorContract.hs",+                "Generated/WorkspaceNominalProof/Project/EventStream.hs",+                "Generated/WorkspaceNominalProof/Project/Harness.hs",+                "Generated/WorkspaceNominalProof/Project/Projection.hs",+                "Generated/WorkspaceNominalProof/ProjectArtifact/Domain.hs",+                "Generated/WorkspaceNominalProof/ProjectArtifact/Codec.hs",+                "Generated/WorkspaceNominalProof/ProjectArtifact/Transducer.hs",+                "Generated/WorkspaceNominalProof/ProjectArtifact/BehaviorContract.hs",+                "Generated/WorkspaceNominalProof/ProjectArtifact/EventStream.hs",+                "Generated/WorkspaceNominalProof/ProjectArtifact/Harness.hs",+                "Generated/WorkspaceNominalProof/ProjectArtifact/Projection.hs",+                "Generated/WorkspaceNominalProof/ReplayAudit.hs"+              ]+        map fst ((.modules) plan) `shouldSatisfy` all (not . isSuffixOfPath "/Holes.hs")+        forM_ compiledPaths $ \path ->+          case [m | (m, _) <- (.modules) plan, m.path == path] of+            [generated] -> do+              committed <- readTestText ("test/conformance-workspace-nominals/" <> path)+              normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) generated)+            found -> expectationFailure ("expected one generated module at " <> path <> ", got " <> show (map (.path) found))+      it "plans a one-member workspace byte-identically to the single-file path" $ do+        let fixtures =+              [ "test/fixtures/reservation.keiro",+                "test/fixtures/consumer-types.keiro",+                "test/fixtures/readmodel.keiro",+                "test/fixtures/hospital-surge.keiro"+              ]+        -- Modules and refusals both: hospital-surge refuses on both+        -- paths, which proves the gates agree as well as the emitters.+        forM_ fixtures $ \path -> do+          (workspace, document) <- exactOneMemberWorkspaceOf path+          let ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = document+              service = checkedSource parsedSource+              spec = checkedSpec service+              ctx = defaultContext (spec.context)+              isSourceMap moduleValue = "BehaviorSourceMap.hs" `isSuffixOfPath` moduleValue+          case (planWorkspaceScaffold "goldens" ctx workspace, planIndexedServiceScaffold sourceIndex ctx service) of+            (Left workspaceRefusals, Left singleSourceRefusals) ->+              workspaceRefusals `shouldBe` singleSourceRefusals+            (Right workspacePlan, Right singleSourceModules) -> do+              let workspaceModules = map fst ((.modules) workspacePlan)+                  workspaceStable = filter (not . isSourceMap) workspaceModules+                  singleSourceStable = filter (not . isSourceMap) singleSourceModules+                  workspaceSourceMaps = filter isSourceMap workspaceModules+                  singleSourceMaps = filter isSourceMap singleSourceModules+              workspaceStable `shouldBe` singleSourceStable+              case (workspaceSourceMaps, singleSourceMaps) of+                ([workspaceSourceMap], [singleSourceMap]) -> do+                  workspaceSourceMap.path `shouldBe` singleSourceMap.path+                  (.text) workspaceSourceMap+                    `shouldBe` T.replace (T.pack path) (T.pack (takeFileName path)) ((.text) singleSourceMap)+                found -> expectationFailure ("expected one source map per planning path, got " <> show (map (.path) (fst found), map (.path) (snd found)))+            (Left _, Right _) -> expectationFailure "workspace planning refused while single-source planning succeeded"+            (Right _, Left _) -> expectationFailure "workspace planning succeeded while single-source planning refused"+        -- The equality is not vacuous: at least one fixture plans, and+        -- its per-node modules are attributed to the single member.+        (workspace, document) <- exactOneMemberWorkspaceOf "test/fixtures/reservation.keiro"+        let ParsedSourceDocument {parsedSource = parsedSource} = document+            spec = checkedSpec (checkedSource parsedSource)+        case planWorkspaceScaffold "goldens" (defaultContext (spec.context)) workspace of+          Left refusals -> expectationFailure ("reservation should plan: " <> show refusals)+          Right plan -> do+            (.modules) plan `shouldSatisfy` (not . null)+            map snd ((.modules) plan)+              `shouldSatisfy` all (`elem` [ContextLevel, MemberOwned "reservation.keiro"])+            map snd ((.modules) plan)+              `shouldSatisfy` elem (MemberOwned "reservation.keiro")+      it "computes obligations from the complete merged graph, spanning members" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        case bindingObligations ((.mergedSpec) workspace) of+          Left graphErrors -> expectationFailure ("merged graph did not resolve: " <> show graphErrors)+          Right obligations ->+            case [o | o <- obligations, (.mappedName) o == "ProjectSummary", (.kind) o == BindingValue] of+              [obligation] -> do+                (.useSites) obligation+                  `shouldSatisfy` any (T.isInfixOf "Project register summary")+                (.useSites) obligation+                  `shouldSatisfy` any (T.isInfixOf "ProjectArtifact command RecordArtifact")+              found -> expectationFailure ("expected one ProjectSummary binding obligation, got " <> show (length found))+      it "refuses a case-folded path collision across members, naming both files" $ do+        workspace <- shouldComposeWorkspace canonicalWorkspacePath+        let collided = withCaseVariantAggregate workspace+        case planWorkspaceScaffold "goldens" (workspaceContext collided) collided of+          Right _ -> expectationFailure "expected a cross-member path collision refusal"+          Left refusals -> do+            let origins = concat [os | PathCollision _ os <- refusals]+            origins `shouldSatisfy` any (T.isInfixOf "domain/project.keiro: ")+            origins `shouldSatisfy` any (T.isInfixOf "domain/project-artifact.keiro: ")+      it "refuses golden fixtures stranded beside a member instead of under the workspace root" $+        withTempDirectory "keiro-dsl-workspace-goldens" $ \root -> do+          workspace <- writeGoldenWorkspace root+          let workspaceGoldens = root </> "golden-payloads"+              fixture = "hospital-capacity/Reservation/TransferReservationCreated.v1.json"+              beside = root </> "domain/golden-payloads" </> fixture+          goldenRootDivergence workspaceGoldens workspace `shouldReturn` []+          createDirectoryIfMissing True (takeDirectory beside)+          TIO.writeFile beside "{}\n"+          refusals <- goldenRootDivergence workspaceGoldens workspace+          refusals `shouldBe` [GoldenRootDivergence workspaceGoldens [beside]]+          renderRefusals refusals+            `shouldSatisfy` any (T.isInfixOf "one golden root per workspace")+          -- The same fixture under the workspace root is no divergence.+          let atRoot = workspaceGoldens </> fixture+          createDirectoryIfMissing True (takeDirectory atRoot)+          TIO.writeFile atRoot "{}\n"+          goldenRootDivergence workspaceGoldens workspace `shouldReturn` []++    describe "workspace scaffold" $ do+      it "writes workspace-keyed history and no context-keyed file at all" $+        withWorkspaceFixture "keiro-dsl-workspace-history" id $ \_ out workspace -> do+          report <- executePlannedWorkspaceScaffold out workspace+          (.recordPath) report+            `shouldBe` out </> workspaceLedgerFileName "demo-project"+          (.buildManifestPath) report+            `shouldBe` out </> workspaceCabalFragmentFileName "demo-project"+          doesFileExist (out </> recordFileName "demo-project") `shouldReturn` False+          doesFileExist (out </> contextCabalFragmentFileName "demo-project") `shouldReturn` False+          contents <- TIO.readFile ((.recordPath) report)+          buildManifest <- TIO.readFile ((.buildManifestPath) report)+          assertGeneratedHaskellContract "service.keiro-workspace" buildManifest+          case parseWorkspaceRecord contents of+            Nothing -> expectationFailure ("workspace record did not parse:\n" <> T.unpack contents)+            Just record -> do+              (.service) record `shouldBe` "demo-project"+              (.manifest) record `shouldBe` "service.keiro-workspace"+              (.queryContractBaseline) record `shouldBe` False+              contents `shouldNotSatisfy` T.isInfixOf "query-contract-baseline"+              (.members) record+                `shouldBe` [ "domain/project-artifact.keiro",+                             "domain/project.keiro",+                             "domain/shared.keiro"+                           ]+              -- Context-level modules are ownerless; everything+              -- else names the member that produced it.+              [(.path) row | row <- (.modules) record, (.owner) row == Nothing]+                `shouldSatisfy` \ownerless ->+                  length ownerless == 6+                    && any (T.isSuffixOf "StructuralConformance.hs" . T.pack) ownerless+                    && any (T.isSuffixOf "BehaviorSourceMap.hs" . T.pack) ownerless+                    && any (T.isSuffixOf "StructuralProjections.hs" . T.pack) ownerless+                    && any (T.isSuffixOf "Nominals.hs" . T.pack) ownerless+                    && any (T.isSuffixOf "Nominals/Internal.hs" . T.pack) ownerless+                    && any (T.isSuffixOf "ReplayAudit.hs" . T.pack) ownerless+              [ (.owner) row+                | row <- (.modules) record,+                  "Project/Generated/Domain.hs" `T.isSuffixOf` T.pack ((.path) row)+                ]+                `shouldBe` [Just "domain/project.keiro"]+      it "refuses and then applies old workspace sidecar names before reading history" $+        withWorkspaceFixture "keiro-dsl-workspace-sidecar-migration" id $ \_ out workspace -> do+          plan <- shouldPlanWorkspaceSpec workspace+          first <- executeWorkspaceScaffold out False plan+          either (\failure -> expectationFailure (show failure)) (const (pure ())) first+          let service = workspace.service+              currentLedger = workspaceLedgerFileName service+              currentFragment = workspaceCabalFragmentFileName service+              oldLedger = legacyWorkspaceRecordFileName service+              oldFragment = legacyWorkspaceManifestFileName service+          renameFile (out </> currentLedger) (out </> oldLedger)+          renameFile (out </> currentFragment) (out </> oldFragment)+          migrationTreeBefore <- treeSnapshot out+          refused <- executeWorkspaceScaffoldWithNameMigrations out False False plan+          refused `shouldSatisfy` \case+            Left [SidecarMigrationRequired moves] ->+              length moves == 2 && all ((== RenameSidecar) . (.moveDisposition)) moves+            _ -> False+          treeSnapshot out `shouldReturn` migrationTreeBefore+          applied <- executeWorkspaceScaffoldWithNameMigrations out False True plan+          report <- either (\failure -> expectationFailure (show failure) >> fail "unreachable") pure applied+          map (.moveDisposition) ((.sidecarMoves) report) `shouldBe` [RenameSidecar, RenameSidecar]+          (.stale) report `shouldBe` []+          doesFileExist (out </> oldLedger) `shouldReturn` False+          doesFileExist (out </> oldFragment) `shouldReturn` False+          doesFileExist (out </> currentLedger) `shouldReturn` True+          doesFileExist (out </> currentFragment) `shouldReturn` True+          rerun <- executeWorkspaceScaffoldWithNameMigrations out False True plan+          either (\failure -> expectationFailure (show failure)) (\value -> (.sidecarMoves) value `shouldBe` []) rerun+      it "is idempotent: an unchanged second run rewrites nothing and reports nothing" $+        withWorkspaceFixture "keiro-dsl-workspace-idempotent" id $ \_ out workspace -> do+          first <- executePlannedWorkspaceScaffold out workspace+          treeBefore <- treeSnapshot out+          second <- executePlannedWorkspaceScaffold out workspace+          treeAfter <- treeSnapshot out+          treeAfter `shouldBe` treeBefore+          map thd3 ((.dispositions) second)+            `shouldSatisfy` all (`elem` [Unchanged, Skipped])+          (.stale) second `shouldBe` []+          (.ownershipMoves) second `shouldBe` []+          (.mappingDrift) second `shouldBe` []+          (.newHoles) second `shouldBe` []+          -- The first run had to write; the claim is not vacuous.+          map thd3 ((.dispositions) first) `shouldSatisfy` any (== Overwritten)+          renderWorkspaceScaffoldReport second+            `shouldSatisfy` all (not . T.isPrefixOf "stale:")+      it "isolates member-local source movement to the one context behavior source map" $+        withWorkspaceFixture "keiro-dsl-workspace-source-movement" id $ \root out workspace -> do+          _ <- executePlannedWorkspaceScaffold out workspace+          treeBefore <- treeSnapshot out+          let member = root </> "domain/project-artifact.keiro"+          original <- TIO.readFile member+          TIO.writeFile member ("# move exact positions without changing semantics\n\n" <> original)+          moved <- loadTempWorkspace root+          second <- executePlannedWorkspaceScaffold out moved+          let overwrittenPaths =+                [(.path) generatedModule | (generatedModule, _, Overwritten) <- (.dispositions) second]+          overwrittenPaths `shouldSatisfy` \case+            [path] -> T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack path)+            _ -> False+          (.declarations) (second.semanticImpact) `shouldBe` []+          map (.category) ((.generatedArtifactImpact) second)+            `shouldBe` [BehaviorSourceMapArtifact]+          treeAfter <- treeSnapshot out+          let isPositionBearingSidecar (path, _) =+                T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack path)+                  || takeFileName path == workspaceLedgerFileName "demo-project"+          filter (not . isPositionBearingSidecar) treeAfter+            `shouldBe` filter (not . isPositionBearingSidecar) treeBefore+      it "produces byte-identical output for members listed in reverse order" $+        withWorkspaceFixture "keiro-dsl-workspace-order-a" id $ \_ outA workspaceA ->+          withWorkspaceFixture "keiro-dsl-workspace-order-b" reverse $ \_ outB workspaceB -> do+            _ <- executePlannedWorkspaceScaffold outA workspaceA+            _ <- executePlannedWorkspaceScaffold outB workspaceB+            treeB <- treeSnapshot outB+            treeA <- treeSnapshot outA+            treeB `shouldBe` treeA+            map fst treeA `shouldSatisfy` elem (workspaceLedgerFileName "demo-project")+      it "reports stale files only for the member that changed" $+        withWorkspaceFixture "keiro-dsl-workspace-stale" id $ \root out workspace -> do+          first <- executePlannedWorkspaceScaffold out workspace+          let siblingPaths =+                [ (.path) m+                | (m, provenance, _) <- (.dispositions) first,+                  provenance == MemberOwned "domain/project-artifact.keiro"+                ]+          siblingsBefore <- traverse (TIO.readFile . (out </>)) siblingPaths+          renamed <- renameMemberAggregate root "domain/project.keiro" "Project" "Ledger"+          second <- executePlannedWorkspaceScaffold out renamed+          let stalePaths = map (.path) ((.stale) second)+          stalePaths `shouldSatisfy` (not . null)+          stalePaths `shouldSatisfy` all (T.isInfixOf "/Project/" . T.pack)+          -- Nothing the sibling member owns is stale, and nothing it+          -- owns changed on disk: no cross-member false positives.+          stalePaths `shouldSatisfy` all (`notElem` siblingPaths)+          siblingsAfter <- traverse (TIO.readFile . (out </>)) siblingPaths+          siblingsAfter `shouldBe` siblingsBefore+          forM_ stalePaths $ \path -> doesFileExist (out </> path) `shouldReturn` True+          (.stale) second+            `shouldSatisfy` all+              ( \stale -> case (.kind) stale of+                  Generated -> (.generatedEvidence) stale == Just ExactGeneratedBannerPresent+                  HoleStub -> (.generatedEvidence) stale == Nothing+              )+          renderWorkspaceScaffoldReport second+            `shouldSatisfy` any (T.isInfixOf "keiro-dsl never deletes files.")+          renderWorkspaceScaffoldReport second+            `shouldSatisfy` any (T.isInfixOf "exact generated banner present; verify unchanged bytes before deleting")+          renderWorkspaceScaffoldReport second+            `shouldSatisfy` all (not . T.isInfixOf "safe to delete")+      it "reports an aggregate moved between members as an ownership move, not stale churn" $+        withWorkspaceFixture "keiro-dsl-workspace-move" id $ \root out workspace -> do+          _ <- executePlannedWorkspaceScaffold out workspace+          treeBefore <- treeSnapshot out+          moved <- moveArtifactAggregate root+          second <- executePlannedWorkspaceScaffold out moved+          (.stale) second `shouldBe` []+          let moves = (.ownershipMoves) second+          moves `shouldSatisfy` (not . null)+          moves+            `shouldSatisfy` all+              ( \move ->+                  (.previous) move == Just "domain/project-artifact.keiro"+                    && (.current) move == Just "domain/project.keiro"+              )+          map (.path) moves+            `shouldSatisfy` any (T.isInfixOf "ProjectArtifact" . T.pack)+          -- Behavior contracts contain only semantic identity. Moving a+          -- declaration rewrites the one source.map.context, while the ledger+          -- independently records module ownership moves.+          map thd3 ((.dispositions) second)+            `shouldSatisfy` all (`elem` [Unchanged, Skipped, Overwritten])+          let overwrittenPaths =+                [(.path) generatedModule | (generatedModule, _, Overwritten) <- (.dispositions) second]+          overwrittenPaths `shouldSatisfy` \case+            [path] -> T.isSuffixOf "/BehaviorSourceMap.hs" (T.pack path)+            _ -> False+          treeAfter <- treeSnapshot out+          map fst treeAfter `shouldBe` map fst treeBefore+          let unaffected (path, _) =+                path /= workspaceLedgerFileName "demo-project"+                  && path `notElem` overwrittenPaths+          filter unaffected treeAfter `shouldBe` filter unaffected treeBefore+          renderWorkspaceScaffoldReport second+            `shouldSatisfy` any (T.isInfixOf "changed owning member")+      it "leaves the tree, record, and manifest untouched when any member refuses" $+        withWorkspaceFixture "keiro-dsl-workspace-atomic" id $ \_ out workspace -> do+          _ <- executePlannedWorkspaceScaffold out workspace+          treeBefore <- treeSnapshot out+          let broken = withCaseVariantAggregate workspace+          case planWorkspaceScaffold "goldens" (workspaceContext broken) broken of+            Right _ -> expectationFailure "expected the broken workspace to refuse"+            Left refusals -> refusals `shouldSatisfy` any isPathCollision+          treeSnapshot out `shouldReturn` treeBefore+          -- A fresh output directory is never even created.+          withTempDirectory "keiro-dsl-workspace-atomic-fresh" $ \fresh -> do+            let target = fresh </> "out"+            case planWorkspaceScaffold "goldens" (workspaceContext broken) broken of+              Right _ -> expectationFailure "expected the broken workspace to refuse"+              Left _ -> doesDirectoryExist target `shouldReturn` False+      it "leaves prior workspace output byte-identical for parse, validation, and collision failures" $+        withWorkspaceFixture "keiro-dsl-workspace-atomic-cli" id $ \root out workspace -> do+          _ <- executePlannedWorkspaceScaffold out workspace+          treeBefore <- treeSnapshot out+          let member = root </> "domain/project-artifact.keiro"+              manifest = root </> "service.keiro-workspace"+          original <- TIO.readFile member+          let failures =+                [ ("parse", "context demo-project\naggregate !!!\n"),+                  ("validation", T.replace "ProjectId" "MissingProjectId" original),+                  ("collision", T.replace "aggregate ProjectArtifact" "aggregate PROJECT" original)+                ]+          forM_ failures $ \(failureKind, brokenSource) -> do+            TIO.writeFile member brokenSource+            (exitCode, stdoutText, stderrText) <-+              runKeiroDsl ["scaffold", manifest, "--out", out]+            unless (exitCode == ExitFailure 1) $+              expectationFailure+                (failureKind <> " failure unexpectedly scaffolded:\n" <> stdoutText <> stderrText)+            treeSnapshot out `shouldReturn` treeBefore+            TIO.writeFile member original+      it "refuses the whole workspace for one bannerless Generated target, changing nothing" $+        withWorkspaceFixture "keiro-dsl-workspace-banner" id $ \_ out workspace -> do+          plan <- shouldPlanWorkspaceSpec workspace+          let generated = [m | (m, _) <- (.modules) plan, (.kind) m == Generated]+          case generated of+            [] -> expectationFailure "workspace fixture has no Generated module"+            target : _ -> do+              let path = out </> target.path+              createDirectoryIfMissing True (takeDirectory path)+              TIO.writeFile path "hand owned\n"+              treeBefore <- treeSnapshot out+              refused <- executeWorkspaceScaffold out False plan+              refused `shouldSatisfy` isMissingBannerRefusal+              treeSnapshot out `shouldReturn` treeBefore+              forced <- executeWorkspaceScaffold out True plan+              forced `shouldSatisfy` isSuccessfulScaffold+              TIO.readFile path `shouldReturn` (.text) target+      it "scaffolds a whole workspace through the CLI" $+        withTempDirectory "keiro-dsl-workspace-cli" $ \out -> do+          (exitCode, stdoutText, stderrText) <-+            runKeiroDsl ["scaffold", canonicalWorkspacePath, "--out", out]+          unless (exitCode == ExitSuccess) (expectationFailure (stdoutText <> stderrText))+          stderrText `shouldContain` "workspace: demo-project"+          doesFileExist (out </> workspaceLedgerFileName "demo-project")+            `shouldReturn` True+          tree <- treeSnapshot out+          length [path | (path, _) <- tree, "StructuralProjections.hs" `T.isSuffixOf` T.pack path]+            `shouldBe` 1+          length [path | (path, _) <- tree, "ReplayAudit.hs" `T.isSuffixOf` T.pack path]+            `shouldBe` 1+          (secondCode, _, secondErr) <-+            runKeiroDsl ["scaffold", canonicalWorkspacePath, "--out", out]+          secondCode `shouldBe` ExitSuccess+          secondErr `shouldSatisfy` (not . isInfixOfString "(overwritten)")+          treeSnapshot out `shouldReturn` tree+      it "accepts a validated runtime-package override and generates exactly one service package" $+        withTempDirectory "keiro-dsl-workspace-runtime-package-cli" $ \out -> do+          (exitCode, stdoutText, stderrText) <-+            runKeiroDsl ["scaffold", canonicalWorkspacePath, "--out", out, "--runtime-package", "demo-runtime"]+          unless (exitCode == ExitSuccess) (expectationFailure (stdoutText <> stderrText))+          tree <- treeSnapshot out+          length [path | (path, _) <- tree, takeExtension path == ".cabal", "keiro-dsl-conformance.workspace.demo-project" `isInfixOfString` path]+            `shouldBe` 1+          stderrText `shouldSatisfy` isInfixOfString "conformance-target: cabal test keiro-demo-project-conformance"++    describe "workspace adoption" $ do+      it "replaces embedded 0.6 nominal declarations only in generated files" $+        withWorkspaceFixture "keiro-dsl-workspace-nominal-adopt" id $ \_ out workspace -> do+          plan <- shouldPlanWorkspaceSpec workspace+          let pathEndingIn suffix selectedKind =+                case [(.path) m | (m, _) <- (.modules) plan, (.kind) m == selectedKind, suffix `isSuffixOfPath` m] of+                  [path] -> pure path+                  found -> expectationFailure ("expected one path ending in " <> suffix <> ", got " <> show found) >> fail "unreachable"+          domainPath <- pathEndingIn "Project/Generated/Domain.hs" Generated+          nominalPath <- pathEndingIn "Generated/Nominals.hs" Generated+          internalNominalPath <- pathEndingIn "Generated/Nominals/Internal.hs" Generated+          path <- pathEndingIn "Project/Holes.hs" HoleStub+          writeFileWithParents+            (out </> domainPath)+            (generatedBanner <> "\n-- legacy 0.6 fixture\nmodule LegacyDomain where\nnewtype ProjectId = ProjectId String\ndata ProjectPhase = Draft | Active\n")+          writeFileWithParents (out </> path) "-- hand-owned 0.6 implementation\n"++          report <- executePlannedWorkspaceScaffold out workspace+          (.stale) report `shouldBe` []+          [disposition | (m, _, disposition) <- (.dispositions) report, m.path == domainPath]+            `shouldBe` [Overwritten]+          [disposition | (m, _, disposition) <- (.dispositions) report, m.path == nominalPath]+            `shouldBe` [Overwritten]+          newDomain <- TIO.readFile (out </> domainPath)+          newDomain `shouldSatisfy` (not . T.isInfixOf "newtype ProjectId")+          newDomain `shouldSatisfy` T.isInfixOf "Generated.Nominals (ProjectId, parseProjectId, ProjectPhase (..))"+          newNominals <- TIO.readFile (out </> nominalPath)+          T.count "newtype ProjectId" newNominals `shouldBe` 0+          T.count "data ProjectPhase =" newNominals `shouldBe` 1+          newInternalNominals <- TIO.readFile (out </> internalNominalPath)+          T.count "newtype ProjectId" newInternalNominals `shouldBe` 1+          TIO.readFile (out </> path) `shouldReturn` "-- hand-owned 0.6 implementation\n"+      it "adopts an overwritten same-context record pair by record and by banner" $+        withInlineWorkspace "keiro-dsl-workspace-adopt" adoptionMembers $ \_ out workspace -> do+          -- Reproduce today's defect first: two same-specs.context+          -- scaffolded independently into one directory, the second+          -- replacing the first's record and calling its files stale.+          specA <- parseInlineSpec "domain/a.keiro" adoptionMemberA+          specB <- parseInlineSpec "domain/b.keiro" adoptionMemberB+          let ctx = defaultContext "adoption-demo"+          legacyA <- executePlannedScaffold out "domain/a.keiro" ctx specA+          legacyB <- executePlannedScaffold out "domain/b.keiro" ctx specB+          (.stale) legacyB `shouldSatisfy` (not . null)+          legacyBefore <- TIO.readFile (out </> recordFileName "adoption-demo")++          report <- executePlannedWorkspaceScaffold out workspace+          (.stale) report `shouldBe` []+          case (.migration) report of+            Nothing -> expectationFailure "expected the first workspace run to adopt"+            Just migration -> do+              let generatedOf run = sort [(.path) m | (m, _) <- (.dispositions) run, (.kind) m == Generated]+                  claimedBy evidence = sort [entry.path | entry <- migration.claimed, entry.evidence == evidence]+              -- The surviving record attributes B's files; A's+              -- files survived only as banners, which is exactly+              -- the orphan case the overwrite created.+              claimedBy ClaimedFromRecord `shouldBe` generatedOf legacyB+              claimedBy ClaimedFromBanner `shouldBe` sort (generatedOf legacyA \\ generatedOf legacyB)+              claimedBy ClaimedFromBanner `shouldSatisfy` (not . null)+              (.likelyStale) migration `shouldBe` []+              (.legacyRecord) migration+                `shouldBe` Just (recordFileName "adoption-demo", "domain/b.keiro")+              -- Provenance is persisted, not merely printed.+              recorded <- parseWorkspaceRecord <$> TIO.readFile ((.recordPath) report)+              fmap (sort . map (.path) . (.adopted)) recorded+                `shouldBe` Just (sort (map (.path) ((.claimed) migration)))+              fmap (sort . nubOrd . map (.evidence) . (.adopted)) recorded+                `shouldBe` Just ["banner", "record"]+              persisted <- TIO.readFile (out </> "keiro-dsl-migration-report.workspace.adoption-demo.txt")+              persisted `shouldBe` T.unlines (renderMigrationReport migration)+              renderWorkspaceScaffoldReport report+                `shouldSatisfy` any (T.isInfixOf "adopting pre-workspace scaffold output")++          -- The legacy record gained one line and nothing else: it+          -- still parses to the same value for an old binary.+          legacyAfter <- TIO.readFile (out </> recordFileName "adoption-demo")+          T.lines legacyAfter `shouldSatisfy` elem (supersededByLine "adoption-demo")+          parseRecord legacyAfter `shouldBe` parseRecord legacyBefore+          T.lines legacyAfter+            `shouldBe` T.lines legacyBefore <> [supersededByLine "adoption-demo"]++          -- Adoption is not a content change: the generated tree is+          -- what a fresh workspace scaffold of the same members emits.+          withInlineWorkspace "keiro-dsl-workspace-adopt-fresh" adoptionMembers $ \_ fresh freshWorkspace -> do+            freshReport <- executePlannedWorkspaceScaffold fresh freshWorkspace+            (.migration) freshReport `shouldBe` Nothing+            adoptedTree <- treeSnapshot out+            freshTree <- treeSnapshot fresh+            haskellOnly adoptedTree `shouldBe` haskellOnly freshTree+      it "adopts and marks context history under the legacy record name" $+        withInlineWorkspace "keiro-dsl-workspace-adopt-legacy-name" adoptionMembers $ \_ out workspace -> do+          specA <- parseInlineSpec "domain/a.keiro" adoptionMemberA+          _ <- executePlannedScaffold out "domain/a.keiro" (defaultContext "adoption-demo") specA+          let current = contextLedgerFileName "adoption-demo"+              legacy = legacyContextRecordFileName "adoption-demo"+          renameFile (out </> current) (out </> legacy)+          ledgerBefore <- TIO.readFile (out </> legacy)+          report <- executePlannedWorkspaceScaffold out workspace+          case (.migration) report of+            Nothing -> expectationFailure "expected legacy-name context history to be adopted"+            Just migration -> (.legacyRecord) migration `shouldBe` Just (legacy, "domain/a.keiro")+          doesFileExist (out </> current) `shouldReturn` False+          ledgerAfter <- TIO.readFile (out </> legacy)+          T.lines ledgerAfter `shouldBe` T.lines ledgerBefore <> [supersededByLine "adoption-demo"]+          parseRecord ledgerAfter `shouldBe` parseRecord ledgerBefore+      it "lists hand-written files as unclaimed and leaves their bytes alone" $+        withInlineWorkspace "keiro-dsl-workspace-unclaimed" adoptionMembers $ \_ out workspace -> do+          plan <- shouldPlanWorkspaceSpec workspace+          case [(.path) m | (m, _) <- (.modules) plan, (.kind) m == HoleStub] of+            [] -> expectationFailure "adoption fixture emits no hole module"+            path : _ -> do+              writeFileWithParents (out </> path) "-- hand filled\n"+              writeFileWithParents (out </> "Notes.hs") "module Notes where\n"+              report <- executePlannedWorkspaceScaffold out workspace+              case (.migration) report of+                Nothing -> expectationFailure "expected a report for a directory holding hand-written files"+                Just migration -> do+                  (.legacyRecord) migration `shouldBe` Nothing+                  (.claimed) migration `shouldBe` []+                  (.unclaimed) migration `shouldBe` sort [path, "Notes.hs"]+              TIO.readFile (out </> path) `shouldReturn` "-- hand filled\n"+              TIO.readFile (out </> "Notes.hs") `shouldReturn` "module Notes where\n"+      it "never claims a bannerless file at a planned Generated path" $+        withInlineWorkspace "keiro-dsl-workspace-unattributable" adoptionMembers $ \_ out workspace -> do+          plan <- shouldPlanWorkspaceSpec workspace+          case [(.path) m | (m, _) <- (.modules) plan, (.kind) m == Generated] of+            [] -> expectationFailure "adoption fixture emits no Generated module"+            target : _ -> do+              writeFileWithParents (out </> target) "hand owned\n"+              refused <- executeWorkspaceScaffold out False plan+              refused `shouldSatisfy` isMissingBannerRefusal+              TIO.readFile (out </> target) `shouldReturn` "hand owned\n"+              doesFileExist (out </> "keiro-dsl-migration-report.workspace.adoption-demo.txt")+                `shouldReturn` False+      it "adopts at most once, and the second run is an ordinary idempotent run" $+        withInlineWorkspace "keiro-dsl-workspace-adopt-once" adoptionMembers $ \_ out workspace -> do+          specA <- parseInlineSpec "domain/a.keiro" adoptionMemberA+          _ <- executePlannedScaffold out "domain/a.keiro" (defaultContext "adoption-demo") specA+          first <- executePlannedWorkspaceScaffold out workspace+          (.migration) first `shouldSatisfy` \case Just _ -> True; Nothing -> False+          treeBefore <- treeSnapshot out+          reportBefore <- TIO.readFile (out </> "keiro-dsl-migration-report.workspace.adoption-demo.txt")+          legacyBefore <- TIO.readFile (out </> recordFileName "adoption-demo")++          second <- executePlannedWorkspaceScaffold out workspace+          (.migration) second `shouldBe` Nothing+          (.stale) second `shouldBe` []+          map thd3 ((.dispositions) second) `shouldSatisfy` all (`elem` [Unchanged, Skipped])+          treeSnapshot out `shouldReturn` treeBefore+          TIO.readFile (out </> "keiro-dsl-migration-report.workspace.adoption-demo.txt")+            `shouldReturn` reportBefore+          legacyAfter <- TIO.readFile (out </> recordFileName "adoption-demo")+          legacyAfter `shouldBe` legacyBefore+          length (filter (== supersededByLine "adoption-demo") (T.lines legacyAfter))+            `shouldBe` 1++comparisonProvenance :: CompareProvenance+comparisonProvenance =+  CompareProvenance+    { historicalCodecIdentity = "example.historical",+      historicalCodecVersion = "legacy-v1",+      canonicalType = CanonicalTypeId "example.Artifact.v1",+      bindingSymbol = QualifiedValueName "Example.Bindings.artifactBinding",+      bindingVersion = BindingVersion "1",+      wireFingerprint = "deadbeef"+    }++syntheticGenerated :: FilePath -> T.Text -> ScaffoldModule+syntheticGenerated path contents =+  ScaffoldModule {path = path, text = contents, kind = Generated, origin = "test"}++data GeneratedTreeDelta = GeneratedTreeDelta+  { changedPaths :: !(Set.Set FilePath),+    addedPaths :: !(Set.Set FilePath),+    removedPaths :: !(Set.Set FilePath),+    changedLineCounts :: !(Map.Map FilePath Int)+  }+  deriving stock (Eq, Show)++generatedTreeDelta :: [ScaffoldModule] -> [ScaffoldModule] -> GeneratedTreeDelta+generatedTreeDelta previous current =+  GeneratedTreeDelta+    { changedPaths = changed,+      addedPaths = added,+      removedPaths = removed,+      changedLineCounts = Map.fromSet changedLineCount impacted+    }+  where+    previousByPath = generatedByPath previous+    currentByPath = generatedByPath current+    previousPaths = Map.keysSet previousByPath+    currentPaths = Map.keysSet currentByPath+    added = currentPaths Set.\\ previousPaths+    removed = previousPaths Set.\\ currentPaths+    shared = previousPaths `Set.intersection` currentPaths+    changed = Set.filter (\path -> Map.lookup path previousByPath /= Map.lookup path currentByPath) shared+    impacted = changed <> added <> removed+    changedLineCount path = case (Map.lookup path previousByPath, Map.lookup path currentByPath) of+      (Just old, Just new) -> differingLineCount ((.text) old) ((.text) new)+      (Just old, Nothing) -> length (T.lines ((.text) old))+      (Nothing, Just new) -> length (T.lines ((.text) new))+      (Nothing, Nothing) -> 0+    generatedByPath modules = Map.fromList [((.path) value, value) | value <- modules, (.kind) value == Generated]++generatedTreeDeltaFromSnapshot :: [(FilePath, T.Text)] -> [(FilePath, T.Text)] -> GeneratedTreeDelta+generatedTreeDeltaFromSnapshot previous current =+  generatedTreeDelta+    [syntheticGenerated path contents | (path, contents) <- previous]+    [syntheticGenerated path contents | (path, contents) <- current]++differingLineCount :: T.Text -> T.Text -> Int+differingLineCount previous current =+  unequalShared + abs (length previousLines - length currentLines)+  where+    previousLines = T.lines previous+    currentLines = T.lines current+    unequalShared = length [() | (old, new) <- zip previousLines currentLines, old /= new]++assertAllowedGeneratedDelta :: Set.Set ModuleRole -> [ScaffoldModule] -> [ScaffoldModule] -> GeneratedTreeDelta -> Expectation+assertAllowedGeneratedDelta allowed previous current delta = do+  (.removedPaths) delta `shouldBe` Set.empty+  actualRoles `shouldSatisfy` (`Set.isSubsetOf` allowed)+  where+    modulesByPath = Map.fromList [((.path) value, value) | value <- previous <> current, (.kind) value == Generated]+    impacted = (.changedPaths) delta <> (.addedPaths) delta <> (.removedPaths) delta+    actualRoles = Set.fromList [moduleRole value | path <- Set.toList impacted, Just value <- [Map.lookup path modulesByPath]]++generatedTextEndingIn :: T.Text -> [ScaffoldModule] -> T.Text+generatedTextEndingIn suffix modules = case [(.text) m | m <- modules, (.kind) m == Generated, suffix `T.isSuffixOf` T.pack ((.path) m)] of+  contents : _ -> contents+  [] -> ""++generatedExtensionsEndingIn :: T.Text -> [ScaffoldModule] -> [T.Text]+generatedExtensionsEndingIn suffix modules = case [generatedModule | generatedModule <- modules, (.kind) generatedModule == Generated, suffix `T.isSuffixOf` T.pack ((.path) generatedModule)] of+  [generatedModule] -> generatedLocalExtensions generatedModule+  matches -> error ("expected one generated module ending in " <> T.unpack suffix <> ", got " <> show (map (.path) matches))++generatedLocalExtensions :: ScaffoldModule -> [T.Text]+generatedLocalExtensions generatedModule =+  [ extension+  | line <- takeWhile (T.isPrefixOf languagePrefix) (T.lines ((.text) generatedModule)),+    Just extensionWithSuffix <- [T.stripPrefix languagePrefix line],+    Just extension <- [T.stripSuffix languageSuffix extensionWithSuffix]+  ]+  where+    languagePrefix = "{-# LANGUAGE "+    languageSuffix = " #-}"++holeTextEndingIn :: T.Text -> [ScaffoldModule] -> T.Text+holeTextEndingIn suffix modules = case [(.text) m | m <- modules, (.kind) m == HoleStub, suffix `T.isSuffixOf` T.pack ((.path) m), not ("BehaviorHoles.hs" `T.isSuffixOf` T.pack ((.path) m))] of+  contents : _ -> contents+  [] -> ""++onlyAggregate :: Spec -> Aggregate+onlyAggregate spec = case [aggregate | NAggregate aggregate <- (.nodes) spec] of+  [aggregate] -> aggregate+  aggregates -> error ("expected one aggregate, got " <> show (length aggregates))++loweringAggregateSpec :: T.Text+loweringAggregateSpec =+  T.unlines+    [ "context samples",+      "",+      "aggregate Counter",+      "  regs",+      "    note Text = \"hello world\"",+      "    count Int = 0",+      "    state CounterVertex = Pending",+      "  states Pending Done!",+      "  command Bump { count:Int }",+      "  event CountBumped { count:Int }",+      "  Pending -- Bump --> emit CountBumped ; goto Done"+    ]++scalarRegisterCases :: [(T.Text, T.Text)]+scalarRegisterCases =+  [ ("Text", "\"sample\""),+    ("Int", "0"),+    ("Bool", "False"),+    ("Time", "\"2026-01-02T03:04:05.123456789012Z\""),+    ("Natural", "0")+  ]++cleanScalarAggregateSpec :: T.Text -> T.Text -> T.Text+cleanScalarAggregateSpec typeName initialValue =+  T.unlines+    [ "context clean-scalar",+      "",+      "aggregate Scalar",+      "  regs",+      "    value " <> typeName <> " = " <> initialValue,+      "  states Empty Done!",+      "  command Set { value:" <> typeName <> " }",+      "  event SetDone { value:" <> typeName <> " }",+      "  Empty -- Set --> write value := value ; emit SetDone ; goto Done"+    ]++exactStatusSpec :: T.Text+exactStatusSpec =+  T.unlines+    [ "context samples",+      "",+      "aggregate Reservation",+      "  regs",+      "    state ReservationVertex = Open",+      "  states Open Closed!",+      "  command Bump { count:Int }",+      "  event ReservationHeld { count:Int }",+      "  event ReservationUnHeld { count:Int }",+      "  event CountBumped { count:Int }",+      "  Open -- Bump --> emit CountBumped ; goto Closed",+      "  projection reservation_status consistency=Eventual key=count",+      "    status-map { ReservationHeld=>held ReservationUnHeld=>available CountBumped=>bumped }"+    ]++hasPathCollisionWithTwoOrigins :: Either [Refusal] [ScaffoldModule] -> Bool+hasPathCollisionWithTwoOrigins = \case+  Left refusals -> any hasTwo refusals+  Right _ -> False+  where+    hasTwo (PathCollision _ origins) = length origins == 2+    hasTwo _ = False++isMissingBannerRefusal :: Either [Refusal] a -> Bool+isMissingBannerRefusal = \case+  Left [MissingGeneratedBanner paths] -> not (null paths)+  _ -> False++isSuccessfulScaffold :: Either [Refusal] a -> Bool+isSuccessfulScaffold = \case+  Right _ -> True+  Left _ -> False++-- Unit tests that construct semantic values directly still need to exercise+-- the production planner's exact-source path. Promote the compatibility spans+-- into an explicitly exact, complete index here; production code never+-- fabricates this provenance.+syntheticExactSourceIndex :: Spec -> SemanticSourceIndex+syntheticExactSourceIndex spec =+  case compatibilitySemanticSourceIndex sourceName spec of+    Left failure -> error ("failed to construct the test source index: " <> show failure)+    Right compatibilityIndex ->+      case exactSemanticSourceIndex sourceName (semanticSourceSubjects spec) entries of+        Left failure -> error ("failed to promote the test source index: " <> show failure)+        Right exactIndex -> exactIndex+      where+        entries = [(subject, sourceSpan) | (subject, _, sourceSpan) <- semanticSourceEntries compatibilityIndex]+  where+    sourceName = "<test-exact>"++planTestServiceScaffold :: Context -> CheckedService -> Either [Refusal] [ScaffoldModule]+planTestServiceScaffold ctx service =+  planIndexedServiceScaffold (syntheticExactSourceIndex (checkedSpec service)) ctx service++planTestServiceScaffoldWithRuntimePackage :: Maybe RuntimePackageName -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]+planTestServiceScaffoldWithRuntimePackage runtimePackage ctx service =+  planIndexedServiceScaffoldWithRuntimePackage runtimePackage (syntheticExactSourceIndex (checkedSpec service)) ctx service++planTestScaffold :: Context -> Spec -> Either [Refusal] [ScaffoldModule]+planTestScaffold ctx spec = planTestServiceScaffold ctx (legacyCheckedService spec)++checkTestServiceDiagnostics :: Maybe RuntimePackageName -> Context -> CheckedService -> [Diagnostic]+checkTestServiceDiagnostics runtimePackage ctx service =+  checkIndexedServiceDiagnostics runtimePackage (syntheticExactSourceIndex (checkedSpec service)) ctx service++executePlannedScaffold :: FilePath -> FilePath -> Context -> Spec -> IO ScaffoldReport+executePlannedScaffold out specPath ctx spec = case planTestScaffold ctx spec of+  Left refusals -> expectationFailure ("unexpected scaffold refusal: " <> show refusals) >> error "unreachable"+  Right modules -> do+    result <- executeScaffold out False specPath ctx spec modules+    case result of+      Left refusals -> expectationFailure ("unexpected execution refusal: " <> show refusals) >> error "unreachable"+      Right report -> pure report++renameCounter :: Node -> Node+renameCounter (NAggregate aggregate) =+  NAggregate+    ( aggregateWithNameAndRegs+        "Widget"+        [regDeclWithValueType (if reg.valueType == TRef "CounterVertex" then TRef "WidgetVertex" else reg.valueType) reg | reg <- aggregate.regs]+        aggregate+    )+renameCounter node = node++onlyPathEndingIn :: FilePath -> [ScaffoldModule] -> FilePath+onlyPathEndingIn suffix modules = case [(.path) m | m <- modules, T.pack suffix `T.isSuffixOf` T.pack ((.path) m)] of+  [path] -> path+  paths -> error ("expected one path ending in " <> suffix <> ", got " <> show paths)++withTempDirectory :: String -> (FilePath -> IO a) -> IO a+withTempDirectory template = bracket acquire removePathForcibly+  where+    acquire = do+      base <- getTemporaryDirectory+      (path, handle) <- openTempFile base template+      hClose handle+      removeFile path+      createDirectory path+      pure path++-- | Parse a fixture and return the validator's diagnostic codes (failing the+-- test on a parse error).+diagnosticCodesOf :: FilePath -> IO [DiagnosticCode]+diagnosticCodesOf path = do+  map (.code) <$> diagnosticsOf path++-- | Parse a fixture and return all validator diagnostics.+diagnosticsOf :: FilePath -> IO [Diagnostic]+diagnosticsOf path = do+  service <- checkedServiceOf path+  pure (validateService service)++-- | Like 'diagnosticCodesOf' but only the Error-severity codes (warnings, e.g.+-- the benign-inversion notices, are excluded).+errorCodesOf :: FilePath -> IO [DiagnosticCode]+errorCodesOf path = do+  diagnostics <- diagnosticsOf path+  pure [(.code) d | d <- diagnostics, (.severity) d == Error]++-- | Parse two fixtures and diff them (old, new).+-- | Plan 143: render an Expr in concrete guard syntax by printing a dummy+-- transition through the real pretty-printer and slicing its guard clause,+-- so the test exercises the exact printer the diff advisory uses.+renderExprText :: Expr -> T.Text+renderExprText e =+  case [T.strip l | l <- T.lines rendered, "guard " `T.isPrefixOf` T.strip l] of+    [guardLine] -> T.strip (T.drop (T.length "guard ") guardLine)+    _ -> error ("renderExprText: unexpected printer output: " <> T.unpack rendered)+  where+    rendered =+      renderTransition+        Transition+          { source = "S",+            command = "C",+            implementation = LegacyHoleImplementation,+            guard = Just e,+            writes = [],+            emits = [],+            outcome = Nothing,+            outcomeDuplicateLocs = [],+            goto = "S",+            mode = TmLive,+            loc = noLoc+          }++-- | Plan 143: a minimal spec whose only transition is replay-only, with the+-- supplied clause lines spliced into its body.+replayOnlySpecWith :: [T.Text] -> T.Text+replayOnlySpecWith clauseLines =+  T.unlines $+    [ "context hospital-capacity",+      "",+      "id TransferReservationId prefix=rsv",+      "",+      "aggregate Reservation",+      "  regs",+      "    reservationId    TransferReservationId = placeholder",+      "    reservationState ReservationVertex     = Unrequested",+      "  states Unrequested Held",+      "",+      "  command RequestTransferReservation { reservationId }",+      "",+      "  event TransferReservationCreated = fields(RequestTransferReservation)",+      "",+      "  replay-only Unrequested -- RequestTransferReservation -->"+    ]+      ++ clauseLines++diffFixtures :: FilePath -> FilePath -> IO [Change]+diffFixtures oldP newP = do+  old <- parsedSourceOf oldP+  new <- parsedSourceOf newP+  pure (diffSources old new)++kindOfChange :: Change -> ChangeKind+kindOfChange (Additive kind) = kind+kindOfChange (Advisory kind) = kind+kindOfChange (Breaking kind) = kind++generatedHaskellNameFindings :: [Change] -> [Change]+generatedHaskellNameFindings = filter ((== GeneratedHaskellNameChanged) . (.code) . kindOfChange)++assertGeneratedHaskellNameFinding :: Change -> Expectation+assertGeneratedHaskellNameFinding change = do+  change `shouldSatisfy` isAdvisory+  let kind = kindOfChange change+      compatibility = kind.vector+      nonBuildVerdicts =+        [ verdictFor surface compatibility+        | surface <- [PrivateHistoryRead, OldBinaryReadNewEvents, SnapshotHydration, PublicConsumer, PersistedIdentity]+        ]+  nonBuildVerdicts `shouldBe` replicate 5 VCompatible+  verdictFor ConsumerBuild compatibility `shouldBe` VAdvisory+  (.rollout) compatibility `shouldBe` Set.empty+  renderFinding change `shouldSatisfy` T.isInfixOf "consumer-build=advisory"+  remediationFor (kind.context) ((.code) kind)+    `shouldBe` RemedyRescaffoldGenerated :| [RemedyRecompileConsumers, RemedyRunConformance]++labelOfChange :: Change -> Label+labelOfChange Additive {} = LabelAdditive+labelOfChange Advisory {} = LabelAdvisory+labelOfChange Breaking {} = LabelBreaking++genSurfaceSet :: Gen (Set.Set CompatibilitySurface)+genSurfaceSet = Set.fromList <$> listOf (elements [minBound .. maxBound])++genCompatibilityVector :: Gen CompatibilityVector+genCompatibilityVector =+  CompatibilityVector+    <$> genVerdict+    <*> genVerdict+    <*> genVerdict+    <*> genVerdict+    <*> genVerdict+    <*> genVerdict+    <*> (Set.fromList <$> listOf (elements rolloutConstraints))+  where+    genVerdict = elements [VCompatible, VAdvisory, VBreaking, VNotApplicable]+    rolloutConstraints =+      [ RolloutStopTheWorld,+        RolloutWorkersFirst,+        RolloutDrainRequired,+        RolloutProducerLast,+        RolloutProducerFirst+      ]++replayImpactFixtures :: FilePath -> FilePath -> IO ReplayImpact+replayImpactFixtures oldPath newPath = do+  old <- checkedServiceOf oldPath+  new <- checkedServiceOf newPath+  pure (resolvedFold (ReplayImpact.replayImpactServices old new))++modifyAggregate :: Name -> (Aggregate -> Aggregate) -> Spec -> Spec+modifyAggregate target update spec =+  specWithNodes+    [ case node of+        NAggregate aggregate | aggregate.name == target -> NAggregate (update aggregate)+        _ -> node+    | node <- spec.nodes+    ]+    spec++modifyReadModel :: Name -> (ReadModelNode -> ReadModelNode) -> Spec -> Spec+modifyReadModel target update spec =+  specWithNodes+    [ case node of+        NReadModel readModel | readModel.name == target -> NReadModel (update readModel)+        _ -> node+    | node <- spec.nodes+    ]+    spec++setLegacySubscription :: Maybe T.Text -> ReadModelSupply -> ReadModelSupply+setLegacySubscription subscription supply = case supply of+  legacy@LegacyReadModelSupply {} -> legacy {legacySubscription = subscription}+  OwnerDerivedSupply -> OwnerDerivedSupply++setLegacyScope :: Maybe RmScope -> ReadModelSupply -> ReadModelSupply+setLegacyScope scope supply = case supply of+  legacy@LegacyReadModelSupply {} -> legacy {legacyScope = scope}+  OwnerDerivedSupply -> OwnerDerivedSupply++setLegacyFeed :: RmFeed -> ReadModelSupply -> ReadModelSupply+setLegacyFeed feed supply = case supply of+  legacy@LegacyReadModelSupply {} -> legacy {legacyFeed = feed}+  OwnerDerivedSupply -> OwnerDerivedSupply++setLegacyConsistency :: Consistency -> ReadModelSupply -> ReadModelSupply+setLegacyConsistency consistency supply = case supply of+  legacy@LegacyReadModelSupply {} -> legacy {legacyConsistency = consistency}+  OwnerDerivedSupply -> OwnerDerivedSupply++mapContract :: (ContractNode -> ContractNode) -> Spec -> Spec+mapContract update spec =+  specWithNodes [case node of { NContract contract -> NContract (update contract); _ -> node } | node <- spec.nodes] spec++mapIntake :: (IntakeNode -> IntakeNode) -> Spec -> Spec+mapIntake update spec =+  specWithNodes [case node of { NIntake intake -> NIntake (update intake); _ -> node } | node <- spec.nodes] spec++mapPgmqDispatch :: (PgmqDispatchNode -> PgmqDispatchNode) -> Spec -> Spec+mapPgmqDispatch update spec =+  specWithNodes [case node of { NPgmqDispatch dispatch -> NPgmqDispatch (update dispatch); _ -> node } | node <- spec.nodes] spec++mapRouter :: (RouterNode -> RouterNode) -> Spec -> Spec+mapRouter update spec =+  specWithNodes [case node of { NRouter router -> NRouter (update router); _ -> node } | node <- spec.nodes] spec++mapEmit :: (EmitNode -> EmitNode) -> Spec -> Spec+mapEmit update spec =+  specWithNodes [case node of { NEmit emitNode -> NEmit (update emitNode); _ -> node } | node <- spec.nodes] spec++mapWorkflow :: (WorkflowNode -> WorkflowNode) -> Spec -> Spec+mapWorkflow update spec =+  specWithNodes [case node of { NWorkflow workflow -> NWorkflow (update workflow); _ -> node } | node <- spec.nodes] spec++mapWorkqueue :: (WorkqueueNode -> WorkqueueNode) -> Spec -> Spec+mapWorkqueue update spec =+  specWithNodes [case node of { NWorkqueue queue -> NWorkqueue (update queue); _ -> node } | node <- spec.nodes] spec++mapDispatch :: (PgmqDispatchNode -> PgmqDispatchNode) -> Spec -> Spec+mapDispatch update spec =+  mapPgmqDispatch update spec++mapOperation :: (OperationNode -> OperationNode) -> Spec -> Spec+mapOperation update spec =+  specWithNodes [case node of { NOperation operation -> NOperation (update operation); _ -> node } | node <- spec.nodes] spec++mapPublisher :: (PublisherNode -> PublisherNode) -> Spec -> Spec+mapPublisher update spec =+  specWithNodes [case node of { NPublisher publisher -> NPublisher (update publisher); _ -> node } | node <- spec.nodes] spec++serviceErrorCodes :: Int -> Spec -> [DiagnosticCode]+serviceErrorCodes versionNumber spec =+  [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]+  where+    service = case languageVersion (fromIntegral versionNumber) >>= effectiveLanguageContractForVersion of+      Nothing -> error ("unsupported test language version " <> show versionNumber)+      Just languageContract -> checkedServiceForContract languageContract spec++-- | Codes emitted at 'Warning' severity under the given released language.+-- Pairs with 'serviceErrorCodes' to assert a surface's warn-then-error tiering+-- from both sides, rather than only proving it is not an error.+serviceWarningCodes :: Int -> Spec -> [DiagnosticCode]+serviceWarningCodes versionNumber spec =+  [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Warning]+  where+    service = case languageVersion (fromIntegral versionNumber) >>= effectiveLanguageContractForVersion of+      Nothing -> error ("unsupported test language version " <> show versionNumber)+      Just languageContract -> checkedServiceForContract languageContract spec++duplicateFirst :: [a] -> [a]+duplicateFirst = \case+  [] -> []+  first : rest -> first : first : rest++updateFirst :: (a -> a) -> [a] -> [a]+updateFirst update = \case+  [] -> []+  first : rest -> update first : rest++removeReadModel :: Name -> Spec -> Spec+removeReadModel target spec =+  specWithNodes [node | node <- spec.nodes, not (isTarget node)] spec+  where+    isTarget (NReadModel readModel) = (.name) readModel == target+    isTarget _ = False++modifyRouter :: Name -> (RouterNode -> RouterNode) -> Spec -> Spec+modifyRouter target update spec =+  specWithNodes+    [ case node of+        NRouter router | router.id == target -> NRouter (update router)+        _ -> node+    | node <- spec.nodes+    ]+    spec++routerErrorCodes :: (RouterNode -> RouterNode) -> Spec -> [DiagnosticCode]+routerErrorCodes update = errorCodes . modifyRouter "PagingRouter" update++modifyProcess :: Name -> (ProcessNode -> ProcessNode) -> Spec -> Spec+modifyProcess target update spec =+  specWithNodes+    [ case node of+        NProcess process | process.id == target -> NProcess (update process)+        _ -> node+    | node <- spec.nodes+    ]+    spec++processErrorCodes :: (ProcessNode -> ProcessNode) -> Spec -> [DiagnosticCode]+processErrorCodes update = errorCodes . modifyProcess "HospitalSurge" update++errorCodes :: Spec -> [DiagnosticCode]+errorCodes spec = [(.code) diagnostic | diagnostic <- validateSpec spec, (.severity) diagnostic == Error]++diagnosticCodes :: Spec -> [DiagnosticCode]+diagnosticCodes = map (.code) . validateSpec++changeReadModelShape :: ReadModelNode -> ReadModelNode+changeReadModelShape readModel =+  readModel+    { columns = (.columns) readModel <> [RmColumn "reviewed_by" "text" False],+      shape = "fnv1a:0000000000000000"+    }++-- | Assert a @new \<kind\>@ skeleton parses and validates with zero+-- error-severity diagnostics.+assertSkeletonValid :: T.Text -> IO ()+assertSkeletonValid kind = case skeletonFor kind of+  Left err -> expectationFailure (T.unpack ("skeleton for " <> kind <> ": " <> err))+  Right src -> case parseSpec ("new:" <> T.unpack kind) src of+    Left perr -> expectationFailure (T.unpack ("skeleton for " <> kind <> " failed to parse: " <> perr))+    Right spec ->+      [(.code) d | d <- validateSpec spec, (.severity) d == Error]+        `shouldBe` ([] :: [DiagnosticCode])++assertSkeletonUsesStableLanguage :: T.Text -> IO ()+assertSkeletonUsesStableLanguage kind = case skeletonFor kind of+  Left err -> expectationFailure (T.unpack ("skeleton for " <> kind <> ": " <> err))+  Right source -> case parseSource ("new:" <> T.unpack kind) source of+    Left failure -> expectationFailure (T.unpack (renderParseFailure failure))+    Right parsed -> do+      let service = checkedSource parsed+      (.contractLanguageVersion) (checkedLanguageContract service) `shouldBe` currentStableLanguageVersion+      effectiveLanguageSupport (checkedLanguageContract service) `shouldBe` Stable+      [(.code) diagnostic | diagnostic <- validateService service, (.severity) diagnostic == Error]+        `shouldBe` ([] :: [DiagnosticCode])+      scaffoldServiceModules (defaultContext ((checkedSpec service).context)) service+        `shouldSatisfy` (not . null)++assertSkeletonScaffoldable :: T.Text -> IO ()+assertSkeletonScaffoldable kind = case skeletonFor kind of+  Left err -> expectationFailure (T.unpack ("skeleton for " <> kind <> ": " <> err))+  Right src -> case parseSpec ("new:" <> T.unpack kind) src of+    Left perr -> expectationFailure (T.unpack perr)+    Right spec -> planTestScaffold (defaultContext (spec.context)) spec `shouldSatisfy` isSuccessfulScaffold++bumpArtifactBindingVersion :: MappedDecl -> MappedDecl+bumpArtifactBindingVersion declaration@MappedStructural {msName = "ArtifactInfo"} =+  declaration {msBindingVersion = Just "2"}+bumpArtifactBindingVersion declaration = declaration++addArtifactSummaryField :: MappedDecl -> MappedDecl+addArtifactSummaryField declaration@MappedStructural {msName = "ArtifactInfo", msShape = ShapeRecord constructor unknownFields fields} =+  declaration+    { msShape =+        ShapeRecord+          constructor+          unknownFields+          ( fields+              <> [ WireField+                     { haskell = "summary",+                       key = "summary",+                       valueType = TText,+                       presence = PRequired,+                       onMissing = Nothing,+                       loc = Loc 0+                     }+                 ]+          )+    }+addArtifactSummaryField declaration = declaration++addAlphaPayloadOptionalField :: Spec -> Spec+addAlphaPayloadOptionalField = addMappedOptionalTextField "AlphaPayload" "note"++addNestedPayloadOptionalField :: Spec -> Spec+addNestedPayloadOptionalField = addMappedOptionalTextField "NestedPayload" "detail"++addMappedOptionalTextField :: Name -> Name -> Spec -> Spec+addMappedOptionalTextField target name spec = spec {mapped = map addField ((.mapped) spec)}+  where+    addField declaration@MappedStructural {msName = declarationName, msShape = ShapeRecord constructor unknownFields fields}+      | declarationName == target =+          declaration+            { msShape =+                ShapeRecord+                  constructor+                  unknownFields+                  ( fields+                      <> [ WireField+                             { haskell = name,+                               key = name,+                               valueType = TOptional TText,+                               presence = POptional,+                               onMissing = Just OmNull,+                               loc = Loc 0+                             }+                         ]+                  )+            }+    addField declaration = declaration++changeAlphaPayloadFixtureSymbol :: Spec -> Spec+changeAlphaPayloadFixtureSymbol spec = spec {mapped = map changeFixture ((.mapped) spec)}+  where+    changeFixture declaration@MappedStructural {msName = "AlphaPayload"} =+      declaration {msFixtures = Just "Example.SemanticLocality.Bindings.alphaPayloadV2Cases"}+    changeFixture declaration = declaration++mapWorkspaceSpec :: (Spec -> Spec) -> WorkspaceSpec -> WorkspaceSpec+mapWorkspaceSpec transform workspace =+  workspaceWithMembersAndMergedSpec+    [workspaceMemberWithSpec (transform member.spec) member | member <- workspace.members]+    (transform workspace.mergedSpec)+    workspace++expectGenericCompileFailure :: FilePath -> String -> Expectation+expectGenericCompileFailure fixture expectedDiagnostic =+  withTempDirectory ("keiro-dsl-generic-" <> fixture) $ \fixtureDir -> do+    let fixtureSource = fixtureDir </> "Fixture.hs"+        domainSource = fixtureDir </> "Domain.hs"+        shapeSource = fixtureDir </> "Shape.hs"+        recordModule moduleName fields =+          T.unlines+            [ "{-# LANGUAGE DeriveGeneric #-}",+              "module " <> moduleName <> " (Item (..)) where",+              "import Data.Text (Text)",+              "import GHC.Generics (Generic)",+              "data Item = Exact {" <> fields <> "}",+              "  deriving stock (Generic)"+            ]+        (domainFields, shapeFields) = case fixture of+          "renamed-field" -> ("contentHash :: Text", "contentDigest :: Text")+          "reordered-field" -> ("first :: Text, second :: Int", "second :: Int, first :: Text")+          "arity-mismatch" -> ("first :: Text", "first :: Text, second :: Int")+          "incompatible-type" -> ("content :: Text", "content :: Int")+          other -> error ("unknown generic compile-fail fixture: " <> other)+    TIO.writeFile domainSource (recordModule "Domain" domainFields)+    TIO.writeFile shapeSource (recordModule "Shape" shapeFields)+    TIO.writeFile+      fixtureSource+      ( T.unlines+          [ "module Fixture where",+            "import Domain qualified",+            "import Keiro.Codec.Structural (StructuralBinding)",+            "import Keiro.Codec.Structural.Generic (genericStructuralBinding)",+            "import Shape qualified",+            "binding :: StructuralBinding Domain.Item Shape.Item",+            "binding = genericStructuralBinding"+          ]+      )+    keiroCorePackageId <- activeCabalPackageId "keiro-core"+    (exitCode, standardOutput, standardError) <-+      readProcessWithExitCode+        "cabal"+        [ "exec",+          "--enable-tests",+          "--",+          "ghc",+          "-XGHC2024",+          "-fno-code",+          "-fforce-recomp",+          "-package-id",+          keiroCorePackageId,+          "-i" <> fixtureDir,+          fixtureSource+        ]+        ""+    exitCode `shouldSatisfy` (/= ExitSuccess)+    let compilerOutput = standardOutput <> standardError+    compilerOutput `shouldContain` expectedDiagnostic+    compilerOutput `shouldContain` "Run keiro-dsl scaffold and fill the binding by hand at this error location in the scaffolded module."+    compilerOutput `shouldContain` takeFileName fixtureSource++activeCabalPackageId :: String -> IO String+activeCabalPackageId packageName = do+  planPaths <- filterM doesFileExist ["dist-newstyle/cache/plan.json", "../dist-newstyle/cache/plan.json"]+  planPath <- case planPaths of+    candidate : _ -> pure candidate+    [] -> expectationFailure "could not find Cabal's dist-newstyle/cache/plan.json" >> fail "unreachable"+  decodedPlan <- Aeson.eitherDecodeFileStrict' planPath :: IO (Either String Value)+  let packageIds = case decodedPlan of+        Right (Aeson.Object plan) -> case KeyMap.lookup "install-plan" plan of+          Just (Aeson.Array entries) ->+            [ T.unpack packageId+            | Aeson.Object entry <- toList entries,+              KeyMap.lookup "pkg-name" entry == Just (Aeson.String (T.pack packageName)),+              KeyMap.lookup "component-name" entry == Just (Aeson.String "lib"),+              Just (Aeson.String packageId) <- [KeyMap.lookup "id" entry]+            ]+          _ -> []+        _ -> []+  case packageIds of+    [packageId] -> pure packageId+    resolvedPackageIds ->+      expectationFailure+        ( "could not resolve one active Cabal package ID for "+            <> packageName+            <> ": "+            <> show resolvedPackageIds+            <> either (\decodeError -> " (plan decode failed: " <> decodeError <> ")") (const "") decodedPlan+        )+        >> fail "unreachable"++moveArtifactBindingIntoGenerated :: MappedDecl -> MappedDecl+moveArtifactBindingIntoGenerated declaration@MappedStructural {msName = "ArtifactInfo"} =+  declaration {msBinding = Just "Generated.ConsumerDemo.Bindings.artifactInfoBinding"}+moveArtifactBindingIntoGenerated declaration = declaration++removeMappedRegisterRequirements :: Spec -> Spec+removeMappedRegisterRequirements spec =+  spec+    { mapped = map removeInitial ((.mapped) spec),+      nodes = map removeRegisters ((.nodes) spec)+    }+  where+    removeInitial declaration@MappedStructural {} = declaration {msInitial = Nothing}+    removeInitial declaration@MappedOpaque {} = declaration {moInitial = Nothing}+    removeRegisters (NAggregate aggregate) =+      NAggregate+        aggregate+          { regs = [],+            transitions = [transition {writes = []} | transition <- (.transitions) aggregate]+          }+    removeRegisters node = node++isImportCycle :: Refusal -> Bool+isImportCycle ImportCycle {} = True+isImportCycle _ = False++isFoldSurfaceRefusal :: Either [Refusal] modules -> Bool+isFoldSurfaceRefusal (Left refusals) = any isFold refusals+  where+    isFold FoldSurfaceRefusal {} = True+    isFold _ = False+isFoldSurfaceRefusal (Right _) = False++-- | The canonical positive workspace fixture: three members under one context.+canonicalWorkspacePath :: FilePath+canonicalWorkspacePath = "test/fixtures/workspace/service.keiro-workspace"++-- | Deterministic workspace source used to model git blobs without invoking git.+memoryContentSource :: Map.Map FilePath T.Text -> ContentSource+memoryContentSource files =+  ContentSource+    { csRead = \path ->+        pure $ maybe (Left ("missing in-memory content: " <> T.pack path)) Right (Map.lookup path files)+    }++changeCode :: Change -> DiagnosticCode+changeCode (Additive kind) = (.code) kind+changeCode (Advisory kind) = (.code) kind+changeCode (Breaking kind) = (.code) kind++breakingSurfaces :: Change -> [CompatibilitySurface]+breakingSurfaces change =+  [ surface+  | surface <- [minBound .. maxBound],+    verdictFor surface (kind.vector) == VBreaking+  ]+  where+    kind = case change of+      Additive value -> value+      Advisory value -> value+      Breaking value -> value++workspaceChangeKind :: Change -> ChangeKind+workspaceChangeKind (Additive kind) = kind+workspaceChangeKind (Advisory kind) = kind+workspaceChangeKind (Breaking kind) = kind++-- | The same members as 'canonicalWorkspacePath', listed in reverse order.+reorderedWorkspacePath :: FilePath+reorderedWorkspacePath = "test/fixtures/workspace/service-reordered.keiro-workspace"++-- | Load and compose a workspace fixture, failing the test on a refusal. The+-- fixture path is package-relative; the loader is rooted at the manifest's own+-- directory, exactly as the CLI roots it.+shouldComposeWorkspace :: FilePath -> IO WorkspaceSpec+shouldComposeWorkspace path = do+  resolved <- resolveTestPath path+  loaded <- loadWorkspace (fileContentSource (takeDirectory resolved)) resolved+  case loaded of+    Left failure ->+      expectationFailure (T.unpack (T.intercalate "\n" (renderWorkspaceFailure resolved failure)))+        >> error "unreachable"+    Right workspace -> pure (workspaceWithManifestPath path workspace)++-- | The 'Context' a workspace scaffolds under, with no CLI overrides: the+-- members' unanimous name.context, the manifest's module-root and layout+-- authority, and the built-in defaults where the manifest is silent.+workspaceContext :: WorkspaceSpec -> Context+workspaceContext workspace =+  Context+    { name = workspace.context,+      moduleRoot = maybe "" id ((.moduleRoot) workspace),+      placement = maybe GeneratedPrefix id ((.layout) workspace)+    }++-- | Compose and plan a workspace fixture, failing the test on any refusal.+shouldPlanWorkspace :: FilePath -> IO WorkspacePlan+shouldPlanWorkspace path = do+  workspace <- shouldComposeWorkspace path+  case planWorkspaceScaffold "goldens" (workspaceContext workspace) workspace of+    Left refusals -> expectationFailure ("unexpected workspace plan refusal: " <> show refusals) >> error "unreachable"+    Right plan -> pure plan++-- | Does a scaffolded module's path end in this suffix?+isSuffixOfPath :: FilePath -> ScaffoldModule -> Bool+isSuffixOfPath suffix m = T.pack suffix `T.isSuffixOf` T.pack ((.path) m)++-- | A workspace record built from real composed data plus two synthetic+-- adoption rows, so the round-trip test exercises every row kind including the+-- JSON encodings shared with the v1 record.+sampleWorkspaceRecord :: WorkspaceSpec -> WorkspaceRecord+sampleWorkspaceRecord workspace =+  WorkspaceRecord+    { service = (.service) workspace,+      manifest = "service.keiro-workspace",+      context = workspace.context,+      moduleRoot = maybe "" id ((.moduleRoot) workspace),+      layout = "collocated",+      members = map (.path) ((.members) workspace),+      sourceLanguages =+        [ WorkspaceSourceLanguageRow ((.path) member) ((.sourceLanguage) member)+        | member <- (.members) workspace+        ],+      languageContract = (.languageContract) workspace,+      namingEdition = IdiomaticNamingV1,+      modules =+        [ WorkspaceModuleRow Generated "Demo/Generated/StructuralProjections.hs" Nothing Nothing,+          WorkspaceModuleRow Generated "Demo/Project/Generated/Domain.hs" (Just "domain/project.keiro") Nothing,+          WorkspaceModuleRow HoleStub "Demo/Project/Holes.hs" (Just "domain/shared.keiro") Nothing+        ],+      mappings = (.mappings) (consumerPlan ((.mergedSpec) workspace)),+      idDomains = [],+      nominalEqualities = nominalEqualityIdentities ((.mergedSpec) workspace),+      bindingObligations = either (const []) id (bindingHoles ((.mergedSpec) workspace)),+      requirements = [],+      projectionCatalogFacts = [],+      queryContractBaseline = True,+      queryContracts = either (const []) id (queryContractIdentities ((.mergedSpec) workspace)),+      routerSelections = [],+      adopted =+        [ AdoptedRow "claimed/One.hs" "record" (Just "keiro-dsl-ledger.context.demo-project.txt") (Just "project.keiro"),+          AdoptedRow "claimed/Two.hs" "banner" Nothing Nothing+        ],+      semanticImpact = Just (semanticImpactSnapshotForSpec ((.mergedSpec) workspace))+    }++-- | Representative byte contracts for the two line-oriented scaffold ledgers.+-- The behavior rows and semantic snapshot come from one checked source fixture;+-- the query row is deliberately explicit so the golden scopes that serialized+-- contract even though the behavior fixture itself has no read model.+representativeRecordMigrationContracts :: IO (ScaffoldRecord, WorkspaceRecord)+representativeRecordMigrationContracts = do+  parsed <- parsedSourceOf "test/fixtures/behavior-complete.keiro"+  let service = checkedSource parsed+      spec = checkedSpec service+      sourceLanguageForm = (.sourceLanguage) parsed+      queryIdentity =+        QueryContractIdentity+          { readModel = "BehaviorSummary",+            position = QueryInputConsumer,+            typeExpression = "RequestId",+            mappedDependencies = ["RequestId"]+          }+  requirements <-+    either+      (\errors -> expectationFailure (show errors) >> fail "unreachable")+      pure+      (Behavior.deriveBehaviorRequirements spec)+  let behaviorRows = Behavior.behaviorRecordRows requirements+      impact = Just (semanticImpactSnapshotForSpec spec)+      singleRecord =+        ScaffoldRecord+          { specPath = "behavior-complete.keiro",+            moduleRoot = "",+            layout = "prefixed",+            sourceLanguage = sourceLanguageForm,+            languageContract = checkedLanguageContract service,+            namingEdition = IdiomaticNamingV2,+            moduleRoles = [],+            files = [],+            mappings = [],+            idDomains = [],+            nominalEqualities = [],+            bindingObligations = [],+            behaviorRequirements = behaviorRows,+            projectionCatalogFacts = [],+            queryContractBaseline = True,+            queryContracts = [queryIdentity],+            routerSelections = [],+            processReactions = [],+            semanticImpact = impact+          }+      workspaceRecord =+        WorkspaceRecord+          { service = "behavior-contract-fixture",+            manifest = "service.keiro-workspace",+            context = spec.context,+            moduleRoot = "",+            layout = "prefixed",+            members = ["behavior-complete.keiro"],+            sourceLanguages = [WorkspaceSourceLanguageRow "behavior-complete.keiro" sourceLanguageForm],+            languageContract = checkedLanguageContract service,+            namingEdition = IdiomaticNamingV1,+            modules = [],+            mappings = [],+            idDomains = [],+            nominalEqualities = [],+            bindingObligations = [],+            requirements = behaviorRows,+            projectionCatalogFacts = [],+            queryContractBaseline = True,+            queryContracts = [queryIdentity],+            routerSelections = [],+            adopted = [],+            semanticImpact = impact+          }+  pure (singleRecord, workspaceRecord)++semanticImpactSnapshotForSpec :: Spec -> SemanticImpactSnapshot+semanticImpactSnapshotForSpec = semanticImpactSnapshot . semanticImpactForSpec++semanticImpactForSpec :: Spec -> SemanticImpact+semanticImpactForSpec spec = case resolveTypeGraph spec of+  Left failures -> error ("test fixture type graph did not resolve: " <> show failures)+  Right graph -> semanticImpact graph++-- | Test-facing selection from the production semantic authority. This does+-- not walk the raw 'Spec' or reconstruct dependency edges.+data MappedSurfaceQualification = MappedSurfaceQualification+  { declaration :: !MappedKey,+    evidence :: !(Set.Set MappedRootEvidence),+    consumers :: !(Set.Set MappedConsumer),+    consequences :: !(Set.Set MappedConsequence)+  }+  deriving stock (Eq, Show)++qualifyMappedSurface :: SemanticImpact -> MappedKey -> MappedSurfaceQualification+qualifyMappedSurface impact key =+  MappedSurfaceQualification+    { declaration = key,+      evidence = Map.findWithDefault Set.empty key ((.declarationEvidence) impact),+      consumers = Map.findWithDefault Set.empty key ((.declarationConsumers) impact),+      consequences = Map.findWithDefault Set.empty key ((.declarationConsequences) impact)+    }++-- | The canonical workspace with a case-variant copy of one member's aggregate+-- grafted onto another member. Composition refuses this shape (EP-153 catches it+-- at the earliest boundary), so the planner's own cross-member collision gate can+-- only be exercised by constructing the graph directly — which is exactly what+-- this does, mirroring the single-file @caseVariant@ construction.+withCaseVariantAggregate :: WorkspaceSpec -> WorkspaceSpec+withCaseVariantAggregate workspace = case [aggregate | NAggregate aggregate <- (.nodes) merged, (.name) aggregate == "Project"] of+  [] -> error "canonical workspace fixture has no Project aggregate"+  aggregate : _ ->+    let shouted = aggregateWithName (T.toUpper aggregate.name) aggregate+        ownershipIndex = workspace.ownership+        mergedWithVariant = specWithNodes (merged.nodes <> [NAggregate shouted]) merged+        ownershipWithVariant =+          OwnershipIndex+            { declarations = ownershipIndex.declarations,+              nodes = Map.insert ("aggregate", shouted.name) ("domain/project-artifact.keiro", Loc 1) ownershipIndex.nodes+            }+     in workspaceWithMergedSpecAndOwnership mergedWithVariant ownershipWithVariant workspace+  where+    merged = (.mergedSpec) workspace++-- | Write a one-member workspace whose member declares an upcaster, so its+-- golden payload fixture has a canonical location. Returns the composed+-- workspace; the caller decides where the fixture lives.+writeGoldenWorkspace :: FilePath -> IO WorkspaceSpec+writeGoldenWorkspace root = do+  source <- readTestText "test/fixtures/reservation-v2.keiro"+  createDirectoryIfMissing True (root </> "domain")+  TIO.writeFile (root </> "domain/reservation.keiro") source+  let manifestPath = root </> "service.keiro-workspace"+  TIO.writeFile manifestPath "service gold-demo\nspec domain/reservation.keiro\n"+  loaded <- loadWorkspace (fileContentSource root) manifestPath+  case loaded of+    Left failure ->+      expectationFailure (T.unpack (T.intercalate "\n" (renderWorkspaceFailure manifestPath failure)))+        >> error "unreachable"+    Right workspace -> pure workspace++-- | Materialize the canonical fixture workspace in a fresh temporary directory+-- and hand the callback its root, a sibling output directory, and the composed+-- workspace. Working on a copy is what lets a test edit a member and re-scaffold.+--+-- The manifest's @spec@ lines are passed through the given function first, so a+-- caller can list the same members in a different order; the manifest __file+-- name__ stays the same, which is what makes two runs comparable byte for byte.+withWorkspaceFixture ::+  String ->+  ([FilePath] -> [FilePath]) ->+  (FilePath -> FilePath -> WorkspaceSpec -> IO a) ->+  IO a+withWorkspaceFixture template orderMembers act =+  withTempDirectory template $ \base -> do+    let root = base </> "workspace"+        out = base </> "out"+        members =+          [ "domain/project-artifact.keiro",+            "domain/project.keiro",+            "domain/shared.keiro"+          ]+    createDirectoryIfMissing True (root </> "domain")+    forM_ members $ \relative -> do+      source <- readTestText ("test/fixtures/workspace" </> relative)+      TIO.writeFile (root </> relative) source+    TIO.writeFile+      (root </> "service.keiro-workspace")+      ( T.unlines+          ( ["service demo-project", "module Demo.Modules.Project", "layout collocated"]+              <> ["spec " <> T.pack relative | relative <- orderMembers members]+          )+      )+    workspace <- loadTempWorkspace root+    act root out workspace++withSemanticLocalityFixture ::+  String ->+  ([FilePath] -> [FilePath]) ->+  Int ->+  (FilePath -> FilePath -> WorkspaceSpec -> IO a) ->+  IO a+withSemanticLocalityFixture template orderMembers unrelatedCount act =+  withTempDirectory template $ \base -> do+    let root = base </> "workspace"+        out = base </> "out"+        members = ["domain/alpha.keiro", "domain/beta.keiro"]+    forM_ members $ \relative -> do+      source <- readTestText ("test/fixtures/semantic-locality" </> relative)+      let withUnrelated+            | relative == "domain/beta.keiro" = source <> unrelatedAggregatesSource unrelatedCount+            | otherwise = source+      writeFileWithParents (root </> relative) withUnrelated+    TIO.writeFile+      (root </> "service.keiro-workspace")+      (T.unlines ("service semantic-locality" : ["spec " <> T.pack relative | relative <- orderMembers members]))+    workspace <- loadTempWorkspace root+    act root out workspace++unrelatedAggregatesSource :: Int -> T.Text+unrelatedAggregatesSource count =+  T.unlines+    ( concat+        [ [ "",+            "aggregate Unrelated" <> suffix,+            "  regs",+            "    marker Bool = False",+            "  states Ready Done!",+            "  command SubmitUnrelated" <> suffix <> " { accepted:Bool }",+            "  event Unrelated" <> suffix <> "Submitted = fields(SubmitUnrelated" <> suffix <> ")",+            "  Ready -- SubmitUnrelated" <> suffix <> " --> guard cmd.accepted ; write marker := true ; emit Unrelated" <> suffix <> "Submitted ; goto Done"+          ]+        | index <- [1 .. count],+          let suffix = T.pack (show index)+        ]+    )++-- | Materialize an inline workspace — a manifest plus literal member sources —+-- in a fresh temporary directory, and hand the callback its root, a sibling output+-- directory, and the composed workspace.+withInlineWorkspace ::+  String ->+  (T.Text, [(FilePath, T.Text)]) ->+  (FilePath -> FilePath -> WorkspaceSpec -> IO a) ->+  IO a+withInlineWorkspace template (service, members) act =+  withTempDirectory template $ \base -> do+    let root = base </> "workspace"+        out = base </> "out"+    forM_ members $ \(relative, source) -> writeFileWithParents (root </> relative) source+    TIO.writeFile+      (root </> "service.keiro-workspace")+      ( T.unlines+          (("service " <> service) : ["spec " <> T.pack relative | (relative, _) <- members])+      )+    workspace <- loadTempWorkspace root+    act root out workspace++-- | Two independently valid members under one context. Each is a complete spec+-- that the pre-workspace single-file scaffolder accepts, which is what lets a test+-- reproduce the overwritten-record defect before adopting.+adoptionMembers :: (T.Text, [(FilePath, T.Text)])+adoptionMembers = ("adoption-demo", [("domain/a.keiro", adoptionMemberA), ("domain/b.keiro", adoptionMemberB)])++adoptionMemberA :: T.Text+adoptionMemberA =+  T.unlines+    [ "context adoption-demo",+      "",+      "aggregate Counter",+      "  regs",+      "    count Int = 0",+      "    state CounterVertex = Pending",+      "  states Pending Done!",+      "  command Bump { count:Int }",+      "  event CountBumped { count:Int }",+      "  Pending -- Bump --> emit CountBumped ; goto Done"+    ]++adoptionMemberB :: T.Text+adoptionMemberB =+  T.unlines+    [ "context adoption-demo",+      "",+      "aggregate Widget",+      "  regs",+      "    size Int = 0",+      "    state WidgetVertex = Draft",+      "  states Draft Shipped!",+      "  command Ship { size:Int }",+      "  event WidgetShipped { size:Int }",+      "  Draft -- Ship --> emit WidgetShipped ; goto Shipped"+    ]++writeFileWithParents :: FilePath -> T.Text -> IO ()+writeFileWithParents path contents = do+  createDirectoryIfMissing True (takeDirectory path)+  TIO.writeFile path contents++-- | Only the Haskell sources of a tree snapshot, dropping bookkeeping files.+haskellOnly :: [(FilePath, T.Text)] -> [(FilePath, T.Text)]+haskellOnly entries = [entry | entry@(path, _) <- entries, ".hs" `T.isSuffixOf` T.pack path]++-- | Compose a workspace that a test just wrote to disk.+loadTempWorkspace :: FilePath -> IO WorkspaceSpec+loadTempWorkspace root = do+  let manifestPath = root </> "service.keiro-workspace"+  loaded <- loadWorkspace (fileContentSource root) manifestPath+  case loaded of+    Left failure ->+      expectationFailure (T.unpack (T.intercalate "\n" (renderWorkspaceFailure manifestPath failure)))+        >> error "unreachable"+    Right workspace -> pure workspace++-- | Plan an already-composed workspace, failing the test on a refusal.+shouldPlanWorkspaceSpec :: WorkspaceSpec -> IO WorkspacePlan+shouldPlanWorkspaceSpec workspace =+  case planWorkspaceScaffold "goldens" (workspaceContext workspace) workspace of+    Left refusals -> expectationFailure ("unexpected workspace plan refusal: " <> show refusals) >> error "unreachable"+    Right plan -> pure plan++-- | Plan then execute a whole-workspace scaffold, failing loudly on either.+executePlannedWorkspaceScaffold :: FilePath -> WorkspaceSpec -> IO WorkspaceScaffoldReport+executePlannedWorkspaceScaffold out workspace = do+  plan <- shouldPlanWorkspaceSpec workspace+  result <- executeWorkspaceScaffold out False plan+  case result of+    Left refusals -> expectationFailure ("unexpected workspace execution refusal: " <> show refusals) >> error "unreachable"+    Right report -> pure report++-- | Rename one member's aggregate in place and recompose. Only the+-- @aggregate \<Name\>@ header is rewritten, so declarations that merely share the+-- prefix (@ProjectId@, @ProjectSummary@) are untouched.+renameMemberAggregate :: FilePath -> FilePath -> T.Text -> T.Text -> IO WorkspaceSpec+renameMemberAggregate root member from to = do+  source <- TIO.readFile (root </> member)+  TIO.writeFile (root </> member) (T.replace ("aggregate " <> from <> "\n") ("aggregate " <> to <> "\n") source)+  loadTempWorkspace root++-- | Move the @ProjectArtifact@ aggregate from the artifact member into the+-- project member, and recompose.+--+-- It is prepended, so the merged spec's node order — and therefore every emitted+-- byte, including the replay-audit assembly's aggregate list — is exactly what it+-- was. That isolates the change to ownership, which is the point of the test.+moveArtifactAggregate :: FilePath -> IO WorkspaceSpec+moveArtifactAggregate root = do+  artifact <- TIO.readFile (root </> "domain/project-artifact.keiro")+  project <- TIO.readFile (root </> "domain/project.keiro")+  case T.breakOn "aggregate ProjectArtifact" artifact of+    (kept, moved) | not (T.null moved) -> do+      TIO.writeFile (root </> "domain/project-artifact.keiro") kept+      TIO.writeFile+        (root </> "domain/project.keiro")+        (T.replace "aggregate Project\n" (moved <> "\naggregate Project\n") project)+      loadTempWorkspace root+    _ -> expectationFailure "artifact member has no ProjectArtifact aggregate" >> error "unreachable"++-- | Every regular file under a directory, as @(relative path, contents)@ sorted+-- by path — the comparison unit for "byte-identical output".+treeSnapshot :: FilePath -> IO [(FilePath, T.Text)]+treeSnapshot root = do+  exists <- doesDirectoryExist root+  if not exists then pure [] else sort <$> walk ""+  where+    walk relative = do+      entries <- listDirectory (root </> relative)+      fmap concat . forM (sort entries) $ \entry -> do+        let child = if null relative then entry else relative </> entry+        isDirectory <- doesDirectoryExist (root </> child)+        if isDirectory+          then walk child+          else do+            contents <- TIO.readFile (root </> child)+            pure [(child, contents)]++scaffoldRecordWithEdition :: GeneratedHaskellNamingEdition -> ScaffoldRecord -> ScaffoldRecord+scaffoldRecordWithEdition edition record = case record of+  ScaffoldRecord+    recordSpecPath+    recordModuleRoot+    recordLayout+    recordSourceLanguage+    recordLanguageContract+    _recordNamingEdition+    recordModuleRoles+    recordFiles+    recordMappings+    recordIdDomains+    recordNominalEqualities+    recordBindingObligations+    recordBehaviorRequirements+    recordProjectionCatalogFacts+    recordQueryContractBaseline+    recordQueryContracts+    recordRouterSelections+    recordProcessReactions+    recordSemanticImpact ->+      ScaffoldRecord+        recordSpecPath+        recordModuleRoot+        recordLayout+        recordSourceLanguage+        recordLanguageContract+        edition+        recordModuleRoles+        recordFiles+        recordMappings+        recordIdDomains+        recordNominalEqualities+        recordBindingObligations+        recordBehaviorRequirements+        recordProjectionCatalogFacts+        recordQueryContractBaseline+        recordQueryContracts+        recordRouterSelections+        recordProcessReactions+        recordSemanticImpact++copyTextTree :: FilePath -> FilePath -> IO ()+copyTextTree source destination =+  treeSnapshot source >>= mapM_ (\(relative, contents) -> writeFileWithParents (destination </> relative) contents)++thd3 :: (a, b, c) -> c+thd3 (_, _, value) = value++isPathCollision :: Refusal -> Bool+isPathCollision PathCollision {} = True+isPathCollision _ = False++isInfixOfString :: String -> String -> Bool+isInfixOfString needle haystack = T.isInfixOf (T.pack needle) (T.pack haystack)++-- | Load a workspace fixture expecting a compose refusal, and return it.+shouldRefuseWorkspace :: FilePath -> IO (NonEmpty WorkspaceDiagnostic)+shouldRefuseWorkspace path = do+  resolved <- resolveTestPath path+  loaded <- loadWorkspace (fileContentSource (takeDirectory resolved)) resolved+  case loaded of+    Left (WorkspaceRefused diagnostics) -> pure diagnostics+    Left other ->+      expectationFailure+        ("expected compose refusals, got:\n" <> T.unpack (T.intercalate "\n" (renderWorkspaceFailure resolved other)))+        >> error "unreachable"+    Right _ -> expectationFailure ("expected " <> path <> " to be refused") >> error "unreachable"++-- | Invoke the built @keiro-dsl@ executable. Fixture paths are resolved first,+-- so the test works whether it runs from the package directory or the repository+-- root.+runKeiroDsl :: [String] -> IO (ExitCode, String, String)+runKeiroDsl arguments = do+  resolved <- traverse resolveArgument arguments+  -- Cabal places build-tool dependencies on PATH for the test process. Invoke the+  -- exact packaged CLI directly so each example retains its process/stdio/exit-code+  -- boundary without paying for a fresh `cabal run` planning pass.+  readProcessWithExitCode "keiro-dsl" resolved ""+  where+    resolveArgument argument+      | "test/fixtures/" `isPrefixOfString` argument = resolveTestPath argument+      | otherwise = pure argument+    isPrefixOfString prefix value = take (length prefix) value == prefix++-- | The @spec@ field of a coverage report, i.e. what the report says it covers.+coverageSpecPath :: Value -> Maybe T.Text+coverageSpecPath value = case value of+  Aeson.Object fields -> case KeyMap.lookup "spec" fields of+    Just (Aeson.String path) -> Just path+    _ -> Nothing+  _ -> Nothing++decodeJsonValue :: FilePath -> IO Value+decodeJsonValue path = do+  decoded <- Aeson.eitherDecodeFileStrict path+  case decoded of+    Left err -> expectationFailure (path <> ": " <> err) >> fail "unreachable"+    Right value -> pure value++jsonField :: T.Text -> Value -> Maybe Value+jsonField name = \case+  Aeson.Object fields -> KeyMap.lookup (Key.fromText name) fields+  _ -> Nothing++-- | Order-preserving deduplication for comparing cited file sets.+nubOrd :: (Eq a) => [a] -> [a]+nubOrd = go []+  where+    go seen [] = reverse seen+    go seen (x : xs) = if x `elem` seen then go seen xs else go (x : seen) xs++-- | Parse a workspace manifest, failing the test on a refusal.+shouldParseManifest :: FilePath -> T.Text -> IO WorkspaceManifest+shouldParseManifest path source = case parseWorkspaceManifest path source of+  Left err -> expectationFailure (T.unpack err) >> error "unreachable"+  Right manifest -> pure manifest++-- | Generate a canonical workspace manifest. Members are drawn from a pool of+-- paths that are distinct even under case folding and are held sorted, which is+-- the invariant every parsed manifest satisfies.+genWorkspaceManifest :: Gen WorkspaceManifest+genWorkspaceManifest = do+  service <- elements ["demo-project", "mori", "kotei", "a1", "svc-2"]+  runtimePackage <- elements [Nothing, Just (RuntimePackageName "demo-core"), Just (RuntimePackageName "mori2")]+  moduleRoot <- elements [Nothing, Just "Demo", Just "Demo.Modules.Project"]+  layout <- elements [Nothing, Just GeneratedPrefix, Just CollocatedLeaf]+  chosen <-+    sublistOf+      [ "a.keiro",+        "d-e_f.keiro",+        "domain/b.keiro",+        "domain/sub/c.keiro",+        "x1.keiro"+      ]+      `suchThat` (not . null)+  pure+    WorkspaceManifest+      { service = service,+        serviceLoc = Loc 1,+        runtimePackage = runtimePackage,+        runtimePackageLoc = Loc 2,+        moduleRoot = moduleRoot,+        moduleRootLoc = Loc 2,+        layout = layout,+        layoutLoc = Loc 3,+        members = NE.fromList [WorkspaceMemberRef path (Loc 4) | path <- sort chosen]+      }++-- | Parse a fixture while retaining its released language contract.+parsedSourceOf :: FilePath -> IO ParsedSource+parsedSourceOf path = do+  input <- readTestText path+  case parseSource path input of+    Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> fail "unreachable"+    Right parsed -> pure parsed++checkedServiceOf :: FilePath -> IO CheckedService+checkedServiceOf = fmap checkedSource . parsedSourceOf++renderFoldBaseline :: T.Text -> CheckedService -> T.Text+renderFoldBaseline fixture service =+  T.intercalate+    "\n\n"+    [ T.unlines+        ( [ "fixture=" <> fixture,+            "aggregate=" <> (.name) aggregate,+            "fingerprint=" <> aggregateFoldFingerprintForService service aggregate,+            "surface-begin"+          ]+            <> T.lines (aggregateFoldSurfaceForService service aggregate)+            <> ["surface-end"]+        )+    | NAggregate aggregate <- (.nodes) (checkedSpec service)+    ]++-- | Parse a fixture through the source-aware boundary and return its graph.+specOf :: FilePath -> IO Spec+specOf = fmap checkedSpec . checkedServiceOf++-- | Parse one fixture through the exact source-aware boundary and adapt it to+-- one-member workspace semantics without falling back to line-only provenance.+exactOneMemberWorkspaceOf :: FilePath -> IO (WorkspaceSpec, ParsedSourceDocument)+exactOneMemberWorkspaceOf path = do+  source <- readTestText path+  document <- case parseSourceDocument path source of+    Left failure -> expectationFailure (show failure) >> fail "unreachable"+    Right value -> pure value+  workspace <-+    either+      (\failure -> expectationFailure (show failure) >> fail "unreachable")+      pure+      (oneMemberParsedDocumentWorkspace path document)+  pure (workspace, document)++-- | Parse a fixture and scaffold its checked semantic service.+scaffoldFixture :: FilePath -> IO [ScaffoldModule]+scaffoldFixture path = do+  service <- checkedServiceOf path+  pure (scaffoldServiceModules (defaultContext ((checkedSpec service).context)) service)++legacyScaffoldProcessFixture :: FilePath -> IO [ScaffoldModule]+legacyScaffoldProcessFixture path = do+  spec <- specOf path+  pure $ concat [scaffoldProcess (ctx spec) process | NProcess process <- (.nodes) spec]+  where+    ctx spec = defaultContext (spec.context)++-- | Assert a freshly-scaffolded Generated module matches its committed copy+-- under test/conformance/ (whitespace-normalized). The committed copies are the+-- ones the keiro-dsl-conformance suite compiles, so this pins the live scaffolder+-- to known-compiling output.+assertMatchesCommitted :: ScaffoldModule -> IO ()+assertMatchesCommitted m = do+  let committedPath = "test/conformance/" <> (.path) m+  committed <- readTestText committedPath+  normalizeGenerated committed `shouldBe` normalizeGenerated ((.text) m)++normalizeGenerated :: T.Text -> (T.Text, [T.Text])+normalizeGenerated text =+  let (orderInsensitiveLines, body) = partition isOrderInsensitive (T.lines text)+   in (normalizeBody body, sort (map normalizeImport orderInsensitiveLines))+  where+    -- Compare the deterministic body exactly as before and imports/language+    -- pragmas as a sorted, whitespace-normalized list. Sorting tolerates+    -- formatter reordering while additions, removals, and renamed entries still+    -- fail the pin.+    isOrderInsensitive line = isImport line || "{-# LANGUAGE " `T.isPrefixOf` line+    normalizeBody =+      -- Fourmolu parenthesizes a single class constraint while the emitter's+      -- compact spelling remains valid Haskell.  Treat that formatter-only+      -- rewrite like the whitespace and comma placement normalized below.+      T.replace "(Show value) =>" "Show value =>"+        . T.replace "( " "("+        . T.replace " )" ")"+        . T.replace " , )" " )"+        . T.unwords+        . T.words+        . T.replace "}" " } "+        . T.replace "{" " { "+        . T.replace "]" " ] "+        . T.replace "[" " [ "+        . T.replace "," " , "+        . T.unlines+        . map normalizeBanner+    normalizeBanner line+      | isGeneratedBannerLine line = generatedBanner+      | otherwise = line+    normalizeImport line =+      let reordered = case T.words line of+            "import" : "qualified" : moduleName : rest -> T.unwords ("import" : moduleName : "qualified" : rest)+            wordsInImport -> T.unwords wordsInImport+          (prefix, explicit) = T.breakOn " (" reordered+       in if T.null explicit+            then prefix+            else+              let members =+                    sort+                      . map (T.replace " (" "(" . T.unwords . T.words)+                      . T.splitOn ","+                      . T.dropEnd 1+                      $ T.drop 2 explicit+               in prefix <> " (" <> T.intercalate "," members <> ")"+    isImport line = case T.words line of+      "import" : _ -> True+      _ -> False++-- | Locate and read a test fixture or committed conformance source regardless+-- of whether the suite was launched from the package directory or repo root.+readTestText :: FilePath -> IO T.Text+readTestText path = resolveTestPath path >>= TIO.readFile++assertMatchesGolden :: FilePath -> T.Text -> IO ()+assertMatchesGolden path actual = do+  resolved <- resolveTestPath path+  update <- lookupEnv "KEIRO_DSL_UPDATE_GOLDENS"+  if update == Just "1"+    then TIO.writeFile resolved (T.stripEnd actual <> "\n")+    else do+      golden <- TIO.readFile resolved+      T.stripEnd actual `shouldBe` T.stripEnd golden++-- | Assert an exact serialized contract, including its final-newline policy.+assertMatchesByteGolden :: FilePath -> BS.ByteString -> IO ()+assertMatchesByteGolden path actual = do+  resolved <- resolveTestPath path+  update <- lookupEnv "KEIRO_DSL_UPDATE_GOLDENS"+  if update == Just "1"+    then BS.writeFile resolved actual+    else BS.readFile resolved >>= (`shouldBe` actual)++-- | Locate a repo file regardless of the test process's current directory.+resolveTestPath :: FilePath -> IO FilePath+resolveTestPath rel = do+  override <- lookupEnv "KEIRO_DSL_TEST_ROOT"+  let candidates = [rel, "keiro-dsl" </> rel] <> maybe [] (\root -> [root </> rel]) override+  existing <- filterM doesFileExist candidates+  case existing of+    path : _ -> pure path+    [] ->+      fail $+        "unable to locate keiro-dsl test file "+          <> show rel+          <> "; tried "+          <> show candidates++leftContains :: T.Text -> Either T.Text a -> Bool+leftContains needle = \case+  Left err -> needle `T.isInfixOf` err+  Right _ -> False++mappedConsumerSurfaceSource :: IO T.Text+mappedConsumerSurfaceSource = do+  base <- readTestText "test/fixtures/consumer-types.keiro"+  pure $+    T.replace "language keiro-dsl 4" "language keiro-dsl 5" base+      <> T.unlines+        [ "",+          "workqueue ArtifactJobs {",+          "  queue logical = \"artifact-jobs\"",+          "  derive physical = \"artifact-jobs\"",+          "    dlq = \"artifact-jobs_dlq\"",+          "    table = \"q_artifact-jobs\"",+          "  payload ArtifactJob {",+          "    jobData -> \"payload\" : List (Optional ArtifactInfo)",+          "  }",+          "  retry maxRetries = 3 delay = 1s dlq = on",+          "  disposition {",+          "    storeFailure -> retry 1s",+          "    commandRejected -> ackOk",+          "    decodeFailure -> deadLetter",+          "    onCodecReject -> deadLetter",+          "  }",+          "}",+          "",+          "readmodel ArtifactLookup {",+          "  table = \"artifact_lookup\"",+          "  schema = \"public\"",+          "  columns {}",+          "  query input = ArtifactInfo",+          "  query result = Optional ArtifactLocation",+          "  version = 1",+          "  shape = \"fixture\"",+          "  freshness = immediate",+          "}"+        ]++changeProjectionMappedWire :: MappedDecl -> MappedDecl+changeProjectionMappedWire declaration@MappedOpaque {moCodecVersion = version} =+  declaration {moCodecVersion = fmap (<> "-changed") version}+changeProjectionMappedWire declaration@MappedStructural {msShape = ShapeUnion encoding arms} =+  declaration+    { msShape =+        ShapeUnion+          encoding+          ( case arms of+              [] -> []+              arm : remaining -> wireArmWithTag (arm.tag <> "-changed") arm : remaining+          )+    }+changeProjectionMappedWire declaration = declaration++projectionEventWithoutGeometry :: Spec -> Spec+projectionEventWithoutGeometry candidate =+  specWithNodes (map stripGeometry candidate.nodes) candidate+  where+    stripGeometry (NAggregate aggregate) =+      let artifactFields =+            [ field+            | command <- (.commands) aggregate,+              (.name) command == "ObserveArtifact",+              field <- (.fields) command,+              (.name) field == "artifact"+            ]+       in NAggregate+            aggregate+              { regs = filter ((/= "currentGeometry") . (.name)) ((.regs) aggregate),+                events = map (explicitArtifactEvent artifactFields) ((.events) aggregate),+                transitions = map stripGeometryWrite ((.transitions) aggregate)+              }+    stripGeometry node = node+    explicitArtifactEvent artifactFields event@Event {body = EventFromCommand commandName}+      | commandName == "ObserveArtifact" =+          eventWithBody (EventFields artifactFields) event+    explicitArtifactEvent _ event = event+    stripGeometryWrite transition = transition {writes = filter ((/= "currentGeometry") . fst) ((.writes) transition)}++parseInlineSpec :: FilePath -> T.Text -> IO Spec+parseInlineSpec sourceName src = case parseSpec sourceName src of+  Left err -> expectationFailure (T.unpack err) >> error "unreachable"+  Right spec -> pure spec++checkedServiceFromText :: FilePath -> T.Text -> IO CheckedService+checkedServiceFromText sourceName src = case parseSource sourceName src of+  Left failure -> expectationFailure (T.unpack (renderParseFailure failure)) >> error "unreachable"+  Right parsed -> pure (checkedSource parsed)++parseStableRenderedSpec :: FilePath -> Spec -> Either T.Text Spec+parseStableRenderedSpec sourceName spec =+  case parseSource sourceName stableSource of+    Left failure -> Left (renderParseFailure failure)+    Right parsed -> Right (parsed.spec)+  where+    stableSource =+      "language keiro-dsl "+        <> T.pack (show (languageVersionNumber currentStableLanguageVersion))+        <> "\n"+        <> renderSpec spec++parseLanguage4RenderedSpec :: FilePath -> Spec -> Either T.Text Spec+parseLanguage4RenderedSpec sourceName spec =+  case parseSource sourceName language4Source of+    Left failure -> Left (renderParseFailure failure)+    Right parsed -> Right (parsed.spec)+  where+    language4Source = "language keiro-dsl 4\n" <> renderSpec spec++shouldParseStableRenderedSpec :: FilePath -> Spec -> IO Spec+shouldParseStableRenderedSpec sourceName spec =+  case parseStableRenderedSpec sourceName spec of+    Left failure -> expectationFailure (T.unpack failure) >> fail "unreachable"+    Right reparsed -> pure reparsed++shouldResolveTypeGraph :: Spec -> IO TypeGraph+shouldResolveTypeGraph spec = case resolveTypeGraph spec of+  Left errors -> expectationFailure ("type graph failed: " <> show errors) >> error "unreachable"+  Right graph -> pure graph++shouldResolveCoverage :: FilePath -> Spec -> IO Coverage.CoverageReport+shouldResolveCoverage path spec = case Coverage.coverageReport path spec of+  Left errors -> expectationFailure ("coverage graph failed: " <> show errors) >> error "unreachable"+  Right report -> pure report++withoutVendorGeometry :: Spec -> Spec+withoutVendorGeometry spec =+  spec+    { mapped = filter (not . isVendorGeometry) ((.mapped) spec),+      nodes = map stripNode ((.nodes) spec)+    }+  where+    isVendorGeometry MappedOpaque {moName = "VendorGeometry"} = True+    isVendorGeometry _ = False+    stripNode (NAggregate aggregate) =+      NAggregate+        aggregate+          { regs = filter ((/= TRef "VendorGeometry") . (.valueType)) ((.regs) aggregate),+            commands = map stripCommand ((.commands) aggregate),+            events = map stripEvent ((.events) aggregate)+          }+    stripNode node = node+    stripCommand command = commandWithFields (filter ((/= Just (TRef "VendorGeometry")) . (.valueType)) command.fields) command+    stripEvent event = eventWithBody (case event.body of EventFields fields -> EventFields (filter ((/= Just (TRef "VendorGeometry")) . (.valueType)) fields); body -> body) event++withMetadataJson :: Spec -> Spec+withMetadataJson spec = spec {mapped = map updateDeclaration ((.mapped) spec)}+  where+    updateDeclaration declaration@MappedStructural {msName = "ArtifactMetadata", msShape = ShapeRecord constructor unknownFields fields} =+      declaration+        { msShape =+            ShapeRecord+              constructor+              unknownFields+              [if field.haskell == "note" then wireFieldWithValueType TJson field else field | field <- fields]+        }+    updateDeclaration declaration = declaration++expressionTags :: TypeExprAlgebra [T.Text]+expressionTags =+  TypeExprAlgebra+    { onText = ["text"],+      onInt = ["int"],+      onInteger = ["integer"],+      onBool = ["bool"],+      onNatural = ["natural"],+      onTime = ["time"],+      onJson = ["json"],+      onOptional = ("optional" :),+      onList = ("list" :),+      onMap = ("map" :),+      onKeyedMap = \key -> (("keyed-map:" <> (.name) key) :),+      onRef = \key -> ["ref:" <> unMappedKey key],+      onNominal = \leaf -> ["nominal:" <> (.name) leaf]+    }++hasTypeGraphError :: (TypeGraphError -> Bool) -> Either (NonEmpty TypeGraphError) TypeGraph -> Bool+hasTypeGraphError predicate = \case+  Left errors -> any predicate errors+  Right _ -> False++isRecursive :: TypeGraphError -> Bool+isRecursive TGRecursive {} = True+isRecursive _ = False++mappedSpec :: [MappedDecl] -> Spec+mappedSpec declarations = Spec "mapped-test" Nothing Nothing [] [] [] [] declarations []++completeStructural :: Name -> MappedShape -> MappedDecl+completeStructural name shape =+  MappedStructural+    { msName = name,+      msHaskell = Just (HaskellSource "mapped-test" "Example.Mapped" name),+      msBinding = Just ("Example.Mapped." <> T.toLower name <> "Binding"),+      msBindingVersion = Just "1",+      msCanonical = Just ("example.mapped." <> name),+      msFixtures = Just ("Example.Mapped." <> T.toLower name <> "Cases"),+      msInitial = Nothing,+      msShape = shape,+      msLoc = noLoc+    }++recordShape :: [TypeExpr] -> MappedShape+recordShape types =+  ShapeRecord+    "MappedRecord"+    RejectUnknown+    [ WireField+        { haskell = "field" <> T.pack (show index),+          key = "field" <> T.pack (show index),+          valueType = valueType,+          presence = PRequired,+          onMissing = Nothing,+          loc = noLoc+        }+    | (index, valueType) <- zip [(1 :: Int) ..] types+    ]++mapArtifactField :: (WireField -> WireField) -> Spec -> Spec+mapArtifactField = mapArtifactNamedField "key"++mapArtifactNamedField :: Name -> (WireField -> WireField) -> Spec -> Spec+mapArtifactNamedField target transform spec = spec {mapped = map updateDeclaration ((.mapped) spec)}+  where+    updateDeclaration declaration@MappedStructural {msName = "ArtifactInfo", msShape = ShapeRecord constructor unknownFields fields} =+      declaration+        { msShape =+            ShapeRecord+              constructor+              unknownFields+              [if (.haskell) field == target then transform field else field | field <- fields]+        }+    updateDeclaration declaration = declaration++mapMappedStructural :: Name -> (MappedDecl -> MappedDecl) -> Spec -> Spec+mapMappedStructural target transform spec =+  spec+    { mapped =+        [ case declaration of+            MappedStructural {msName = name}+              | name == target -> transform declaration+            _ -> declaration+        | declaration <- (.mapped) spec+        ]+    }++renameRecordConstructor :: MappedShape -> MappedShape+renameRecordConstructor (ShapeRecord _ unknownFields fields) = ShapeRecord "ArtifactInfoV2" unknownFields fields+renameRecordConstructor shape = shape++renameMappedRecordConstructor :: MappedDecl -> MappedDecl+renameMappedRecordConstructor declaration@MappedStructural {msShape = shape} =+  declaration {msShape = renameRecordConstructor shape}+renameMappedRecordConstructor declaration = declaration++changeMappedCanonical :: MappedDecl -> MappedDecl+changeMappedCanonical declaration@MappedStructural {} =+  declaration {msCanonical = Just "example.artifact.ArtifactInfo.v2"}+changeMappedCanonical declaration = declaration++data MappedMutation = MappedMutation+  { mmCandidate :: !Spec,+    mmCode :: !DiagnosticCode,+    mmExpectedSubjects :: !(Set.Set T.Text)+  }+  deriving stock (Show)++mappedWireMutations :: Spec -> [MappedMutation]+mappedWireMutations spec = case resolveTypeGraph spec of+  Left _ -> []+  Right graph -> concatMap (uncurry (declarationMutations graph)) (zip [0 :: Int ..] ((.mapped) spec))+  where+    declarationMutations graph declarationIndex declaration = case declaration of+      MappedStructural {msName = declarationName, msShape = shape} -> case shape of+        ShapeRecord _ _ fields ->+          concat+            [ [ mutation+                  graph+                  declarationName+                  MappedWireKeyChanged+                  (fieldSubject (wireFieldWithKey (field.key <> "__mutated") field))+                  (mutateRecordField declarationIndex fieldIndex (\value -> wireFieldWithKey (value.key <> "__mutated") value) spec),+                mutation+                  graph+                  declarationName+                  MappedPresenceChanged+                  (fieldSubject field)+                  (mutateRecordField declarationIndex fieldIndex (\value -> wireFieldWithPresence (flipPresence value.presence) value) spec)+              ]+                <> [ mutation+                       graph+                       declarationName+                       defaultCode+                       (fieldSubject field)+                       (mutateRecordField declarationIndex fieldIndex (wireFieldWithOnMissing changedDefault) spec)+                   | oldDefault <- maybeToListTest ((.onMissing) field),+                     let (changedDefault, defaultCode) = mutateDefault oldDefault+                   ]+            | (fieldIndex, field) <- zip [0 :: Int ..] fields+            ]+        ShapeEnum entries ->+          [ mutation+              graph+              declarationName+              MappedEnumSpellingChanged+              (enumSubject (wireEnumWithTag (entry.tag <> "__mutated") entry))+              (mutateEnumEntry declarationIndex entryIndex (\value -> wireEnumWithTag (value.tag <> "__mutated") value) spec)+          | (entryIndex, entry) <- zip [0 :: Int ..] entries+          ]+        ShapeUnion _ arms ->+          [ mutation+              graph+              declarationName+              MappedArmTagChanged+              (armSubject (wireArmWithTag (arm.tag <> "__mutated") arm))+              (mutateUnionArm declarationIndex armIndex (\value -> wireArmWithTag (value.tag <> "__mutated") value) spec)+          | (armIndex, arm) <- zip [0 :: Int ..] arms+          ]+      MappedOpaque {moName = declarationName, moCodecVersion = version} ->+        [ mutation+            graph+            declarationName+            MappedOpaqueCodecChanged+            "codec"+            ( updateMappedAt+                declarationIndex+                ( \case+                    value@MappedOpaque {} -> value {moCodecVersion = fmap (<> "__mutated") version}+                    value -> value+                )+                spec+            )+        ]++    mutation graph declarationName diagnosticCode leaf candidate =+      MappedMutation+        { mmCandidate = candidate,+          mmCode = diagnosticCode,+          mmExpectedSubjects =+            Set.fromList+              [ renderUsePath path <> " " <> leaf+              | path <- usePaths graph declarationName+              ]+        }++fieldSubject :: WireField -> T.Text+fieldSubject field = ".field " <> (.haskell) field <> "[\"" <> (.key) field <> "\"]"++enumSubject :: WireEnum -> T.Text+enumSubject entry = ".enum " <> (.ctor) entry <> "[\"" <> (.tag) entry <> "\"]"++armSubject :: WireArm -> T.Text+armSubject arm = ".arm " <> (.ctor) arm <> "[\"" <> (.tag) arm <> "\"]"++flipPresence :: Presence -> Presence+flipPresence PRequired = POptional+flipPresence POptional = PRequired++mutateDefault :: OnMissing -> (Maybe OnMissing, DiagnosticCode)+mutateDefault = \case+  OmNull -> (Nothing, MappedDefaultRemoved)+  OmText value -> (Just (OmText (value <> "__mutated")), MappedDefaultChanged)+  OmInt value -> (Just (OmInt (value + 1)), MappedDefaultChanged)+  OmBool value -> (Just (OmBool (not value)), MappedDefaultChanged)+  OmEmptyList -> (Nothing, MappedDefaultRemoved)+  OmEmptyMap -> (Nothing, MappedDefaultRemoved)+  OmCtor constructor -> (Just (OmCtor (constructor <> "Mutated")), MappedDefaultChanged)++mutateRecordField :: Int -> Int -> (WireField -> WireField) -> Spec -> Spec+mutateRecordField declarationIndex fieldIndex transform =+  updateMappedAt declarationIndex $ \case+    declaration@MappedStructural {msShape = ShapeRecord constructor unknownFields fields} ->+      declaration {msShape = ShapeRecord constructor unknownFields (updateAt fieldIndex transform fields)}+    declaration -> declaration++mutateEnumEntry :: Int -> Int -> (WireEnum -> WireEnum) -> Spec -> Spec+mutateEnumEntry declarationIndex entryIndex transform =+  updateMappedAt declarationIndex $ \case+    declaration@MappedStructural {msShape = ShapeEnum entries} ->+      declaration {msShape = ShapeEnum (updateAt entryIndex transform entries)}+    declaration -> declaration++mutateUnionArm :: Int -> Int -> (WireArm -> WireArm) -> Spec -> Spec+mutateUnionArm declarationIndex armIndex transform =+  updateMappedAt declarationIndex $ \case+    declaration@MappedStructural {msShape = ShapeUnion encoding arms} ->+      declaration {msShape = ShapeUnion encoding (updateAt armIndex transform arms)}+    declaration -> declaration++updateMappedAt :: Int -> (MappedDecl -> MappedDecl) -> Spec -> Spec+updateMappedAt declarationIndex transform spec =+  spec {mapped = updateAt declarationIndex transform ((.mapped) spec)}++updateAt :: Int -> (a -> a) -> [a] -> [a]+updateAt target transform values =+  [if index == target then transform value else value | (index, value) <- zip [0 :: Int ..] values]++maybeToListTest :: Maybe a -> [a]+maybeToListTest = maybe [] pure++isAdditiveChange :: Change -> Bool+isAdditiveChange Additive {} = True+isAdditiveChange Advisory {} = False+isAdditiveChange Breaking {} = False++mappedIngredientMutations :: Spec -> [(Spec, DiagnosticCode)]+mappedIngredientMutations spec =+  [ (mapMappedStructural "ArtifactInfo" clearStructuralHaskell spec, MappedMissingIngredient),+    (mapMappedStructural "ArtifactInfo" clearStructuralBinding spec, MappedMissingIngredient),+    (mapMappedStructural "ArtifactInfo" clearStructuralBindingVersion spec, MappedMissingIngredient),+    (mapMappedStructural "ArtifactInfo" clearStructuralCanonical spec, MappedMissingIngredient),+    (mapMappedStructural "ArtifactInfo" clearStructuralFixtures spec, MappedMissingIngredient),+    (mapMappedStructural "ArtifactInfo" clearStructuralInitial spec, MappedMissingInitialValue),+    (mapMappedDeclaration "VendorGeometry" clearOpaqueHaskell spec, MappedMissingIngredient),+    (mapMappedDeclaration "VendorGeometry" clearOpaqueCodec spec, MappedMissingIngredient),+    (mapMappedDeclaration "VendorGeometry" clearOpaqueCodecVersion spec, MappedMissingIngredient),+    (mapMappedDeclaration "VendorGeometry" clearOpaqueFixtures spec, MappedMissingIngredient)+  ]+  where+    clearStructuralHaskell declaration@MappedStructural {} = declaration {msHaskell = Nothing}+    clearStructuralHaskell declaration = declaration+    clearStructuralBinding declaration@MappedStructural {} = declaration {msBinding = Nothing}+    clearStructuralBinding declaration = declaration+    clearStructuralBindingVersion declaration@MappedStructural {} = declaration {msBindingVersion = Nothing}+    clearStructuralBindingVersion declaration = declaration+    clearStructuralCanonical declaration@MappedStructural {} = declaration {msCanonical = Nothing}+    clearStructuralCanonical declaration = declaration+    clearStructuralFixtures declaration@MappedStructural {} = declaration {msFixtures = Nothing}+    clearStructuralFixtures declaration = declaration+    clearStructuralInitial declaration@MappedStructural {} = declaration {msInitial = Nothing}+    clearStructuralInitial declaration = declaration+    clearOpaqueHaskell declaration@MappedOpaque {} = declaration {moHaskell = Nothing}+    clearOpaqueHaskell declaration = declaration+    clearOpaqueCodec declaration@MappedOpaque {} = declaration {moCodecId = Nothing}+    clearOpaqueCodec declaration = declaration+    clearOpaqueCodecVersion declaration@MappedOpaque {} = declaration {moCodecVersion = Nothing}+    clearOpaqueCodecVersion declaration = declaration+    clearOpaqueFixtures declaration@MappedOpaque {} = declaration {moFixtures = Nothing}+    clearOpaqueFixtures declaration = declaration++mapMappedDeclaration :: Name -> (MappedDecl -> MappedDecl) -> Spec -> Spec+mapMappedDeclaration target transform spec =+  spec+    { mapped =+        [ if mappedDeclarationName declaration == target then transform declaration else declaration+        | declaration <- (.mapped) spec+        ]+    }++mappedDeclarationName :: MappedDecl -> Name+mappedDeclarationName MappedStructural {msName = name} = name+mappedDeclarationName MappedOpaque {moName = name} = name++statusMapSpec :: T.Text -> T.Text+statusMapSpec marker =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "  states Open",+      "",+      "  event Created { }",+      "  event Changed { }",+      "",+      "  projection things consistency=Eventual key=thingId",+      "    status-map" <> marker <> " { Created=>held }"+    ]++parseErrorOf :: FilePath -> T.Text -> IO T.Text+parseErrorOf sourceName src = case parseSpec sourceName src of+  Left err -> pure err+  Right _ -> expectationFailure ("expected parse failure for " <> sourceName) >> error "unreachable"++duplicateGotoSpec :: T.Text+duplicateGotoSpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "  states A B C",+      "",+      "  command Go { }",+      "  A -- Go -->",+      "    goto B",+      "    goto C"+    ]++missingGotoSpec :: T.Text+missingGotoSpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "  states A B",+      "",+      "  command Go { }",+      "  A -- Go -->",+      "    emit Changed"+    ]++duplicateWireSpec :: T.Text+duplicateWireSpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "  states Open",+      "",+      "  wire kind=ctorName fields=camelCase schemaVersion=1",+      "  wire kind=typeName fields=snakeCase schemaVersion=2"+    ]++duplicateProjectionSpec :: T.Text+duplicateProjectionSpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "  states Open",+      "",+      "  projection first consistency=Strong key=thingId",+      "    status-map partial { }",+      "  projection second consistency=Eventual key=thingId"+    ]++projectionWithoutConsistencySpec :: T.Text+projectionWithoutConsistencySpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "  states Open",+      "",+      "  projection things key=thingId"+    ]++malformedRegisterSpec :: T.Text+malformedRegisterSpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "    status Status",+      "  states Open"+    ]++misplacedDispatchIdSpec :: T.Text+misplacedDispatchIdSpec =+  T.replace+    "    schedule timer\n\n  dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)\n"+    "    dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)\n    schedule timer\n"+    (renderSpec (Spec "svc" Nothing Nothing [] [] [] [] [] [NProcess (processWithLiteral "literal")]))++lineNumberContaining :: T.Text -> T.Text -> Int+lineNumberContaining needle = go 1 . T.lines+  where+    go current = \case+      [] -> current+      lineText : rest+        | needle `T.isInfixOf` lineText -> current+        | otherwise -> go (current + 1) rest++decimalOverflow :: T.Text+decimalOverflow = "18446744073709551617"++decimalOverflowSpecs :: [(String, T.Text)]+decimalOverflowSpecs =+  [ ("event-version", eventVersionDecimalSpec decimalOverflow),+    ("wire-schema", wireDecimalSpec decimalOverflow),+    ("contract-schema", contractDecimalSpec decimalOverflow),+    ("decode-schema", decodeDecimalSpec decimalOverflow),+    ("publisher-attempts", publisherDecimalSpec decimalOverflow),+    ("workqueue-retries", workqueueDecimalSpec decimalOverflow),+    ("timer-attempts", timerDecimalSpec decimalOverflow)+  ]++eventVersionDecimalSpec :: T.Text -> T.Text+eventVersionDecimalSpec value =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "  states Open",+      "",+      "  event Changed v" <> value <> " { }"+    ]++wireDecimalSpec :: T.Text -> T.Text+wireDecimalSpec value =+  T.unlines+    [ "context svc",+      "",+      "aggregate Thing",+      "  regs",+      "  states Open",+      "",+      "  wire kind=ctorName fields=camelCase schemaVersion=" <> value+    ]++contractDecimalSpec :: T.Text -> T.Text+contractDecimalSpec value =+  T.unlines+    [ "context svc",+      "",+      "contract Contract {",+      "  schemaVersion " <> value,+      "  discriminator kind",+      "}"+    ]++decodeDecimalSpec :: T.Text -> T.Text+decodeDecimalSpec value =+  T.unlines+    [ "context svc",+      "",+      "intake Inbox {",+      "  contract Contract",+      "  topic events",+      "  accept Event",+      "  dedupe key messageId policy PreferIntegrationMessageId",+      "  decode { envelope strict-required lenient-optional body strict schemaVersion == " <> value <> " }",+      "  disposition { }",+      "}"+    ]++publisherDecimalSpec :: T.Text -> T.Text+publisherDecimalSpec value =+  T.unlines+    [ "context svc",+      "",+      "publisher Publisher {",+      "  emit Emit",+      "  ordering PerKeyHeadOfLine",+      "  maxAttempts " <> value,+      "  backoff constant 2s",+      "  outboxId stable from messageId",+      "}"+    ]++workqueueDecimalSpec :: T.Text -> T.Text+workqueueDecimalSpec value =+  T.unlines+    [ "context svc",+      "",+      "workqueue Queue {",+      "  queue logical = \"queue\"",+      "  derive physical = \"queue\"",+      "    dlq = \"queue_dlq\"",+      "    table = \"pgmq.q_queue\"",+      "  payload Job { }",+      "  retry maxRetries = " <> value <> " delay = 5s dlq = on",+      "  disposition { }",+      "}"+    ]++timerDecimalSpec :: T.Text -> T.Text+timerDecimalSpec value =+  T.replace+    "max-attempts 5"+    ("max-attempts " <> value)+    (renderSpec (Spec "svc" Nothing Nothing [] [] [] [] [] [NProcess (processWithLiteral "literal")]))++identifierHygieneSpec :: T.Text+identifierHygieneSpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate thing",+      "  regs",+      "  states Open",+      "",+      "  command DoIt { data }"+    ]++vertexCollisionSpec :: T.Text+vertexCollisionSpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate Reservation",+      "  regs",+      "  states Created",+      "",+      "  event ReservationCreated { }"+    ]++underscoreNodeSpec :: T.Text+underscoreNodeSpec =+  T.unlines+    [ "context svc",+      "",+      "contract _contract {",+      "  schemaVersion 1",+      "  discriminator kind",+      "}"+    ]++normalizedCollisionSpec :: T.Text+normalizedCollisionSpec =+  T.unlines+    [ "context svc",+      "",+      "contract fooBar {",+      "  schemaVersion 1",+      "  discriminator kind",+      "}",+      "",+      "contract foo_bar {",+      "  schemaVersion 1",+      "  discriminator kind",+      "}"+    ]++unicodeIdentifierSpec :: T.Text+unicodeIdentifierSpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate Résumé",+      "  regs",+      "  states Open"+    ]++emptyStatesSpec :: Spec+emptyStatesSpec =+  Spec+    "svc"+    Nothing+    Nothing+    []+    []+    []+    []+    []+    [NAggregate (Aggregate "Thing" [] [] [] [] [] Nothing [] Nothing Nothing Nothing noLoc)]++crossFamilyBoundarySpec :: T.Text+crossFamilyBoundarySpec =+  T.unlines+    [ "context svc",+      "",+      "aggregate First",+      "  regs",+      "  states A B",+      "  command Go { }",+      "  A -- Go -->",+      "    emit Changed",+      "    goto B",+      "",+      "emit Output {",+      "  contract Contract",+      "  topic events",+      "  source \"source\"",+      "  key thingId",+      "  map status { _ => skip }",+      "  messageId derive hole",+      "  idempotencyKey derive hole",+      "}",+      "",+      "aggregate Second",+      "  regs",+      "  states",+      "",+      "dispatch QueueDispatch {",+      "  source readModel = source key = thingId",+      "  fanout body = resolveFanout",+      "  dedup key = thingId",+      "    seenIn readModel = seen field = thingId",+      "    seenIn queue = workQueue field = thingId",+      "  enqueue to = workQueue",+      "}"+    ]++--------------------------------------------------------------------------------+-- Generators (bounded; restricted to valid, non-reserved identifiers)+--------------------------------------------------------------------------------++-- | Text that exercises every supported escape plus notation punctuation that+-- used to be able to split one emit-map row into several rows.+genAdversarialText :: Gen T.Text+genAdversarialText =+  T.concat+    <$> resize+      20+      (listOf (elements ["a", "Z", "\"", "\\", "\n", "\t", "\r", "=>", "#", "{", "}", " "]))++-- | One spec carrying the same adversarial value through three distinct+-- printer paths: a contract topic, an emit-map value, and a quote-wrapped+-- field-binding literal.+escapedSpec :: T.Text -> Spec+escapedSpec value =+  Spec+    "escape"+    Nothing+    Nothing+    []+    []+    []+    []+    []+    [ NContract+        ContractNode+          { name = "Contract",+            schemaVersion = 1,+            discriminator = "kind",+            topics = [("events", value)],+            events = [],+            loc = noLoc+          },+      NEmit+        EmitNode+          { name = "Emit",+            contract = "Contract",+            topic = "events",+            source = "source",+            key = "key",+            discriminant = "status",+            map = [EmitMapRow value "Event" noLoc],+            skip = True,+            messageId = DeriveSpec Nothing,+            idempotencyKey = DeriveSpec Nothing,+            loc = noLoc+          },+      NProcess (processWithLiteral value)+    ]++processWithLiteral :: T.Text -> ProcessNode+processWithLiteral value =+  ProcessNode+    { id = "Process",+      name = "process",+      correlate = CorrelateDecl "key" "idText",+      saga = SagaRef "Saga" "saga",+      target = "Target",+      projections = [],+      body =+        LegacyProcessBody+          (InputDecl "Input" [] Nothing noLoc)+          ( HandleNode+              { on = "Input",+                advance = AdvanceNode "Advance" [FieldBinding "literal" (Just ("\"" <> value <> "\""))],+                dispatch = [],+                schedule = "timer"+              }+          )+          ( TimerNode+              { name = "timer",+                id = IdExpr UuidV5Id "timer:" "correlationId",+                fireAt = FireAtExpr "observedAt" "5m",+                payload = [],+                fire =+                  FireNode+                    { target = "Target",+                      key = "correlationId",+                      command = "Fire",+                      fields = [],+                      firedEventId = IdExpr UuidV5Id "fired:" "correlationId",+                      disposition = FireDisposition OFired OFired ORetry ORetry ORetry+                    },+                decodeUnknown = "Cancelled",+                maxAttempts = 5,+                deadLetter = "exhausted",+                loc = noLoc+              }+          ),+      rejected = PolHalt,+      poison = PolHalt,+      loc = noLoc+    }++genName :: Gen Name+genName =+  frequency+    [ ( 3,+        do+          base <- elements ["Aa", "Bb", "Cc", "Dd", "St", "Cmd", "Ev", "Reg", "Fld", "Foo", "Bar", "Qux"]+          n <- choose (0, 9 :: Int)+          pure (T.pack (base <> show n))+      ),+      (1, elements ["data1", "typeA", "whereX", "gotoX", "guardY", "emitZ", "_lead"])+    ]++genWire :: Gen T.Text+genWire = do+  base <- elements ["red", "blue", "green", "ctorName", "camelCase", "rsv", "hosp", "held", "partial-divert", "1st"]+  n <- choose (0, 9 :: Int)+  pure (T.pack (base <> show n))++genWireWord :: Gen T.Text+genWireWord = genWire++smallList :: Gen a -> Gen [a]+smallList g = choose (0, 3 :: Int) >>= \n -> vectorOf n g++nonEmptyList :: Gen a -> Gen [a]+nonEmptyList g = choose (1, 3 :: Int) >>= \n -> vectorOf n g++genMaybe :: Gen a -> Gen (Maybe a)+genMaybe g = oneof [pure Nothing, Just <$> g]++genCmp :: Gen CmpOp+genCmp = elements [OpEq, OpNeq, OpLt, OpLe, OpGt, OpGe]++genAtom :: Gen Expr+genAtom = EAtom <$> oneof [AName <$> genName, ABool <$> arbitrary]++genExpr :: Gen Expr+genExpr = go (3 :: Int)+  where+    go 0 = genAtom+    go d =+      oneof+        [ genAtom,+          EOr <$> go (d - 1) <*> go (d - 1),+          EAnd <$> go (d - 1) <*> go (d - 1),+          ECmp <$> genCmp <*> go (d - 1) <*> go (d - 1)+        ]++genField :: Gen Field+genField = Field <$> genName <*> oneof [pure Nothing, Just <$> genName]++genAggregateField :: Gen AggregateField+genAggregateField = AggregateField <$> genName <*> pure Nothing <*> pure Nothing <*> genMaybe (genTypeExpr []) <*> pure noLoc++genReg :: Gen RegDecl+genReg = RegDecl <$> genName <*> genTypeExpr [] <*> genRegInitial <*> pure noLoc++genRegInitial :: Gen RegInitial+genRegInitial = oneof [RegInitBare <$> genName, RegInitText <$> genAdversarialText]++genState :: Gen StateDecl+genState = StateDecl <$> genName <*> arbitrary <*> pure noLoc++genCommand :: Gen Command+genCommand = Command <$> genName <*> smallList genAggregateField <*> pure noLoc++genEvent :: Gen Event+genEvent = do+  name <- genName+  eventBody <- body+  version <- choose (1, 3)+  upcast <- genMaybe ((,) <$> choose (0, 3) <*> pure Hole)+  (retiring, deprecated) <- elements [(False, False), (True, False), (False, True)]+  pure+    Event+      { name = name,+        body = eventBody,+        version = version,+        upcastFrom = upcast,+        retiring = retiring,+        deprecated = deprecated,+        loc = noLoc+      }+  where+    body = oneof [EventFromCommand <$> genName, EventFields <$> smallList genAggregateField]++genTransition :: Gen Transition+genTransition =+  Transition+    <$> genName+    <*> genName+    <*> pure LegacyHoleImplementation+    <*> genMaybe genExpr+    <*> smallList ((,) <$> genName <*> genExpr)+    <*> smallList genName+    <*> pure Nothing+    <*> pure []+    <*> genName+    <*> elements [TmLive, TmReplayOnly]+    <*> pure noLoc++genWireSpec :: Gen WireSpec+genWireSpec = WireSpec <$> genWire <*> genWire <*> (getNonNegative <$> arbitrary)++genProjection :: Gen ProjectionSpec+genProjection =+  ProjectionSpec+    <$> genName+    <*> genMaybe (elements [Strong, Eventual])+    <*> genName+    <*> genMaybe (Mapping <$> smallList ((,) <$> genName <*> genWire) <*> arbitrary)+    <*> pure noLoc++genAggregate :: Gen Aggregate+genAggregate =+  Aggregate+    <$> genName+    <*> smallList genReg+    <*> smallList genState+    <*> smallList genCommand+    <*> smallList genEvent+    <*> smallList genTransition+    <*> pure Nothing+    <*> pure []+    <*> genMaybe genWireSpec+    <*> genMaybe genProjection+    <*> genMaybe (SnapshotSpec <$> oneof [SnapEvery <$> choose (0, 5), pure SnapOnTerminal] <*> choose (0, 5) <*> genAdversarialText <*> pure noLoc)+    <*> pure noLoc++genDottedRef :: Gen T.Text+genDottedRef = elements ["input.id", "input.hospitalId", "timer.id", "correlationId", "payload.messageId"]++genWindow :: Gen T.Text+genWindow = elements ["0s", "5s", "2m", "1h"]++genFieldBinding :: Gen FieldBinding+genFieldBinding =+  FieldBinding+    <$> genName+    <*> oneof+      [ pure Nothing,+        Just <$> genDottedRef,+        Just . (\raw -> "\"" <> raw <> "\"") <$> genAdversarialText+      ]++genDispatchDisposition :: Gen DispatchDisposition+genDispatchDisposition = DispatchDisposition <$> genDisp <*> genDisp <*> genDisp+  where+    genDisp = oneof [pure DAckOk, pure DRetry, DDeadLetter <$> genAdversarialText]++genDispatchNode :: Gen DispatchNode+genDispatchNode =+  DispatchNode+    <$> genName+    <*> genDottedRef+    <*> genName+    <*> smallList genFieldBinding+    <*> genDispatchDisposition+    <*> pure noLoc++genFireDisposition :: Gen FireDisposition+genFireDisposition =+  FireDisposition+    <$> elements [OFired, ORetry]+    <*> elements [OFired, ORetry]+    <*> elements [OFired, ORetry]+    <*> elements [OFired, ORetry]+    <*> elements [OFired, ORetry]++genIdExpr :: Gen IdExpr+genIdExpr = IdExpr UuidV5Id <$> genAdversarialText <*> pure "correlationId"++genFireNode :: Gen FireNode+genFireNode =+  FireNode+    <$> genName+    <*> genDottedRef+    <*> genName+    <*> smallList genFieldBinding+    <*> genIdExpr+    <*> genFireDisposition++genTimerNode :: Gen TimerNode+genTimerNode =+  TimerNode+    <$> genName+    <*> genIdExpr+    <*> (FireAtExpr <$> genName <*> genWindow)+    <*> smallList genFieldBinding+    <*> genFireNode+    <*> genName+    <*> choose (0, 5)+    <*> genAdversarialText+    <*> pure noLoc++genProcess :: Gen ProcessNode+genProcess =+  ProcessNode+    <$> genName+    <*> genAdversarialText+    <*> (CorrelateDecl <$> genName <*> genName)+    <*> (SagaRef <$> genName <*> genAdversarialText)+    <*> genName+    <*> smallList genName+    <*> ( LegacyProcessBody+            <$> (InputDecl <$> genName <*> smallList genField <*> pure Nothing <*> pure noLoc)+            <*> (HandleNode <$> genName <*> (AdvanceNode <$> genName <*> smallList genFieldBinding) <*> smallList genDispatchNode <*> genName)+            <*> genTimerNode+        )+    <*> elements [PolHalt, PolDeadLetter, PolSkip]+    <*> elements [PolHalt, PolDeadLetter, PolSkip]+    <*> pure noLoc++genResolveSource :: Gen ResolveSource+genResolveSource = oneof [ResolveReadModel <$> genName, pure ResolveHole]++genRouter :: Gen RouterNode+genRouter =+  RouterNode+    <$> genName+    <*> genAdversarialText+    <*> (InputDecl <$> genName <*> smallList genField <*> pure Nothing <*> pure noLoc)+    <*> (CorrelateDecl <$> genName <*> genName)+    <*> (ResolveDecl <$> genResolveSource <*> smallList genName <*> pure noLoc)+    <*> genName+    <*> smallList genName+    <*> (RouterDispatchNode <$> genName <*> smallList genFieldBinding <*> genDispatchDisposition <*> pure noLoc)+    <*> elements [PolHalt, PolDeadLetter, PolSkip]+    <*> elements [PolHalt, PolDeadLetter, PolSkip]+    <*> pure noLoc++genContractField :: Gen ContractField+genContractField = ContractField <$> genName <*> pure Nothing <*> pure Nothing <*> oneof [CTypeId <$> genAdversarialText, pure CText, pure CInt] <*> pure noLoc++genContractEvent :: Gen ContractEvent+genContractEvent = ContractEvent <$> genName <*> genName <*> smallList genContractField++genContract :: Gen ContractNode+genContract =+  ContractNode+    <$> genName+    <*> choose (0, 5)+    <*> genName+    <*> smallList ((,) <$> genName <*> genAdversarialText)+    <*> smallList genContractEvent+    <*> pure noLoc++genWireSource :: Gen WireSource+genWireSource = oneof [SrcHeader <$> genAdversarialText, pure SrcBody, pure SrcKafkaKey, pure SrcKafkaCursor]++genInboxAction :: Gen InboxAction+genInboxAction = oneof [pure IAckOk, IRetry <$> genWindow, IDeadLetter <$> genMaybe genAdversarialText]++genDispositionRow :: Gen DispositionRow+genDispositionRow = DispositionRow <$> genName <*> genInboxAction <*> pure noLoc++genDecodeSpec :: Gen DecodeSpec+genDecodeSpec =+  DecodeSpec+    <$> ((\first second -> first <> " " <> second) <$> genWireWord <*> genWireWord)+    <*> arbitrary+    <*> choose (0, 5)++genIntake :: Gen IntakeNode+genIntake =+  IntakeNode+    <$> genName+    <*> genName+    <*> genName+    <*> nonEmptyList genName+    <*> smallList (BindRow <$> genName <*> genWireSource <*> arbitrary <*> arbitrary)+    <*> genName+    <*> genName+    <*> pure IdemInboxTable+    <*> elements [InkPersistFull, InkPersistDedupeOnly]+    <*> genDecodeSpec+    <*> smallList genDispositionRow+    <*> pure noLoc++genDeriveSpec :: Gen DeriveSpec+genDeriveSpec = DeriveSpec <$> genMaybe genAdversarialText++genEmit :: Gen EmitNode+genEmit =+  EmitNode+    <$> genName+    <*> genName+    <*> genName+    <*> genAdversarialText+    <*> genName+    <*> genName+    <*> smallList (EmitMapRow <$> genAdversarialText <*> genName <*> pure noLoc)+    <*> arbitrary+    <*> genDeriveSpec+    <*> genDeriveSpec+    <*> pure noLoc++genPublisher :: Gen PublisherNode+genPublisher =+  PublisherNode+    <$> genName+    <*> genName+    <*> genName+    <*> choose (0, 5)+    <*> (BackoffSpec <$> genName <*> genWindow <*> genMaybe genWindow <*> genMaybe (elements ["1.0", "2.0", "3"]))+    <*> genName+    <*> pure noLoc++genWqField :: Gen WqField+genWqField = WqField <$> genName <*> genAdversarialText <*> (LegacyQueueScalar . QueueOther <$> genName) <*> pure noLoc++genWqDispRow :: Gen WqDispRow+genWqDispRow = WqDispRow <$> genName <*> genInboxAction <*> pure noLoc++genWorkqueue :: Gen WorkqueueNode+genWorkqueue =+  WorkqueueNode+    <$> genName+    <*> genAdversarialText+    <*> genAdversarialText+    <*> genAdversarialText+    <*> genAdversarialText+    -- The round-trip property renders no language preamble and therefore parses as Language 1.+    <*> elements [WqUnordered, WqFifoThroughput, WqFifoRoundRobin]+    <*> genMaybe (WqGroupKey <$> genName <*> genName <*> genMaybe genAdversarialText)+    <*> oneof [pure WqStandard, pure WqUnlogged, WqPartitioned <$> genAdversarialText <*> genAdversarialText]+    <*> genName+    <*> smallList genWqField+    <*> choose (0, 5)+    <*> genWindow+    <*> arbitrary+    <*> smallList genWqDispRow+    <*> pure noLoc++genReadModel :: Gen ReadModelNode+genReadModel = do+  consistency <- elements [Strong, Eventual]+  scope <- genMaybe (oneof [pure RmEntireLog, RmCategory <$> genAdversarialText])+  feed <- elements [RmInline, RmSubscription]+  subscription <- genMaybe genAdversarialText+  ReadModelNode+    <$> genName+    <*> nonEmptyText+    <*> nonEmptyText+    <*> smallList (RmColumn <$> genWireWord <*> genName <*> arbitrary)+    <*> choose (0, 5)+    <*> genAdversarialText+    <*> pure (case consistency of Eventual -> FreshnessImmediate; Strong -> FreshnessWaitForHead (maybe RmEntireLog id scope))+    <*> pure (LegacyReadModelSupply consistency scope feed subscription)+    <*> pure Nothing+    <*> pure []+    <*> pure Nothing+    <*> pure Nothing+    <*> pure noLoc+  where+    nonEmptyText = genAdversarialText `suchThat` (not . T.null)++genPgmqDispatch :: Gen PgmqDispatchNode+genPgmqDispatch =+  PgmqDispatchNode+    <$> genName+    <*> genName+    <*> genName+    <*> genName+    <*> genName+    <*> genName+    <*> genName+    <*> genName+    <*> genName+    <*> genName+    <*> pure noLoc++genWfBodyItem :: Gen WfBodyItem+genWfBodyItem = sized go+  where+    go size =+      oneof $+        [ WfStep <$> genWireWord <*> genName <*> pure noLoc,+          WfAwait <$> genWireWord <*> genName <*> pure noLoc,+          WfSleep <$> genWireWord <*> genName <*> pure noLoc,+          WfChild <$> genWireWord <*> genName <*> genName <*> pure noLoc,+          WfContinueAsNew <$> genName <*> pure noLoc+        ]+          ++ [ WfPatch <$> genWireWord <*> resize (size `div` 2) (smallList genWfBodyItem) <*> pure noLoc+             | size > 0+             ]++genWorkflow :: Gen WorkflowNode+genWorkflow =+  WorkflowNode+    <$> genName+    <*> genAdversarialText+    <*> genName+    <*> smallList genField+    <*> genName+    <*> genMaybe genName+    <*> genName+    <*> smallList genWfBodyItem+    <*> pure noLoc++genOperationShape :: Gen OperationShape+genOperationShape =+  oneof+    [ CommandOp <$> genName <*> genName <*> genName <*> smallList genName,+      QueryOp <$> genName <*> genName <*> ((\parts -> T.unwords parts) <$> nonEmptyList genName) <*> genName,+      SignalOp <$> genWireWord <*> genName <*> genName <*> genName <*> genName,+      RunOp <$> genName <*> genName <*> genName+    ]++genOperation :: Gen OperationNode+genOperation = OperationNode <$> genName <*> genOperationShape <*> pure noLoc++allNodeTags :: [String]+allNodeTags = ["aggregate", "process", "router", "contract", "intake", "emit", "publisher", "workqueue", "pgmq-dispatch", "readmodel", "workflow", "operation"]++nodeTag :: Node -> String+nodeTag = \case+  NAggregate _ -> "aggregate"+  NProcess _ -> "process"+  NRouter _ -> "router"+  NContract _ -> "contract"+  NIntake _ -> "intake"+  NEmit _ -> "emit"+  NPublisher _ -> "publisher"+  NWorkqueue _ -> "workqueue"+  NPgmqDispatch _ -> "pgmq-dispatch"+  NReadModel _ -> "readmodel"+  NProjectionTarget _ -> "projection-target"+  NRebuildGroup _ -> "rebuild-group"+  NProjectionRevision _ -> "projection-revision"+  NExternalRead _ -> "external-read"+  NProjectionOwner _ -> "projection-owner"+  NWorkflow _ -> "workflow"+  NOperation _ -> "operation"++consumerNominalFor :: Name -> NominalOwnership+consumerNominalFor name =+  ConsumerNominal+    ConsumerNominalBinding+      { haskell = HaskellSource "domain" "Domain.Types" name,+        binding = QualifiedValueName "Domain.Bindings.binding",+        bindingVersion = BindingVersion "1",+        canonical = CanonicalTypeId ("domain." <> name <> ".v1"),+        fixtures = QualifiedValueName "Domain.Bindings.fixtures",+        initial = Just (QualifiedValueName "Domain.Bindings.initialValue")+      }++genId :: Gen IdDecl+genId = IdDecl <$> genName <*> genWire <*> pure Nothing <*> pure noLoc++genEnum :: Gen EnumDecl+genEnum = EnumDecl <$> genName <*> smallList ((,) <$> genName <*> genWire) <*> pure Nothing <*> pure noLoc++genRule :: Gen RuleDecl+genRule =+  RuleDecl+    <$> genName+    <*> genName+    <*> genName+    <*> nonEmptyList ((,) <$> genName <*> genExpr)+    <*> pure noLoc++genMappedDecls :: Gen [MappedDecl]+genMappedDecls = do+  count <- choose (0, 4 :: Int)+  let names = take count ["MappedA", "MappedB", "MappedC", "MappedD"]+  traverse (genMappedDecl names) names++genMappedDecl :: [Name] -> Name -> Gen MappedDecl+genMappedDecl names name =+  oneof+    [ MappedStructural name+        <$> genMaybe genHaskellSource+        <*> genMaybe genAdversarialText+        <*> genMaybe genAdversarialText+        <*> genMaybe genAdversarialText+        <*> genMaybe genAdversarialText+        <*> genMaybe genAdversarialText+        <*> genMappedShape names+        <*> pure noLoc,+      MappedOpaque name+        <$> genMaybe genHaskellSource+        <*> genMaybe genAdversarialText+        <*> genMaybe genAdversarialText+        <*> genMaybe genAdversarialText+        <*> genMaybe genAdversarialText+        <*> pure noLoc+    ]++genHaskellSource :: Gen HaskellSource+genHaskellSource =+  HaskellSource+    <$> genWire+    <*> genModuleRoot+    <*> genName++genMappedShape :: [Name] -> Gen MappedShape+genMappedShape names =+  oneof+    [ ShapeRecord+        <$> genName+        <*> elements [RejectUnknown, IgnoreUnknown]+        <*> smallList (genWireField names),+      ShapeEnum <$> smallList (WireEnum <$> genName <*> genAdversarialText <*> pure noLoc),+      ShapeUnion+        <$> (TaggedObject <$> genAdversarialText <*> genAdversarialText <*> elements [RejectUnknown, IgnoreUnknown])+        <*> smallList (WireArm <$> genName <*> genAdversarialText <*> genMaybe (genTypeExpr names) <*> pure noLoc)+    ]++genWireField :: [Name] -> Gen WireField+genWireField names =+  WireField+    <$> genName+    <*> genAdversarialText+    <*> genTypeExpr names+    <*> elements [PRequired, POptional]+    <*> genMaybe genOnMissing+    <*> pure noLoc++genTypeExpr :: [Name] -> Gen TypeExpr+genTypeExpr names = sized (go . min 3)+  where+    go 0 = base+    go depth =+      frequency+        [ (4, base),+          (1, TOptional <$> go (depth - 1)),+          (1, TList <$> go (depth - 1)),+          (1, TMap <$> go (depth - 1))+        ]+    -- This generator renders through the unversioned/version-1 grammar. Keep+    -- successor-only Integer coverage in the dedicated version-2 properties.+    base = elements ([TText, TInt, TBool, TNatural, TTime, TJson] ++ map TRef names)++genOnMissing :: Gen OnMissing+genOnMissing =+  oneof+    [ pure OmNull,+      OmText <$> genAdversarialText,+      OmInt <$> choose (-10, 10),+      OmBool <$> arbitrary,+      pure OmEmptyList,+      pure OmEmptyMap,+      OmCtor <$> genName+    ]++genSpec :: Gen Spec+genSpec = do+  name <- genWire+  moduleRoot <- genMaybe genModuleRoot+  layout <- genMaybe (elements [GeneratedPrefix, CollocatedLeaf])+  ids <- smallList genId+  enums <- smallList genEnum+  rules <- smallList genRule+  mapped <- genMappedDecls+  nodes <- smallList genNode+  pure (Spec name moduleRoot layout ids enums rules [] mapped nodes)+  where+    genNode =+      oneof+        [ NAggregate <$> genAggregate,+          NProcess <$> genProcess,+          NRouter <$> genRouter,+          NContract <$> genContract,+          NIntake <$> genIntake,+          NEmit <$> genEmit,+          NPublisher <$> genPublisher,+          NWorkqueue <$> genWorkqueue,+          NPgmqDispatch <$> genPgmqDispatch,+          NReadModel <$> genReadModel,+          NWorkflow <$> genWorkflow,+          NOperation <$> genOperation+        ]++-- | A dotted PascalCase module prefix, e.g. @Acme@ or @Acme.Services@.+genModuleRoot :: Gen T.Text+genModuleRoot = do+  n <- choose (1, 3 :: Int)+  segs <- vectorOf n (elements ["Acme", "Services", "Hospital", "Domain", "Core"])+  pure (T.intercalate "." segs)++assertGeneratedHaskellContract :: T.Text -> T.Text -> Expectation+assertGeneratedHaskellContract sourceName manifest =+  take 13 (T.lines manifest)+    `shouldBe` [ "-- keiro-dsl build manifest for " <> sourceName,+                 "-- Paste the complete fragment below into the consuming Cabal stanza.",+                 "-- The generated layer is overwritten on every scaffold; hole modules are",+                 "-- create-if-absent (filled by hand).",+                 "",+                 "default-language: GHC2024",+                 "default-extensions:",+                 "    DuplicateRecordFields",+                 "    NoFieldSelectors",+                 "    OverloadedRecordDot",+                 "    OverloadedStrings",+                 "",+                 "other-modules:"+               ]++workspaceWithMembers :: [WorkspaceMember] -> WorkspaceSpec -> WorkspaceSpec+workspaceWithMembers members workspace =+  WorkspaceSpec+    { service = workspace.service,+      manifestPath = workspace.manifestPath,+      languageContract = workspace.languageContract,+      context = workspace.context,+      runtimePackage = workspace.runtimePackage,+      moduleRoot = workspace.moduleRoot,+      layout = workspace.layout,+      members = members,+      mergedSpec = workspace.mergedSpec,+      sourceIndex = workspace.sourceIndex,+      lineMap = workspace.lineMap,+      ownership = workspace.ownership+    }++specWithNodes :: [Node] -> Spec -> Spec+specWithNodes nodes (Spec contextName moduleRoot layout ids enums rules nominalScalars mapped _) =+  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes++specWithContext :: Name -> Spec -> Spec+specWithContext contextName (Spec _ moduleRoot layout ids enums rules nominalScalars mapped nodes) =+  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes++specWithMapped :: [MappedDecl] -> Spec -> Spec+specWithMapped mapped (Spec contextName moduleRoot layout ids enums rules nominalScalars _ nodes) =+  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes++specWithNominalScalars :: [NominalScalarDecl] -> Spec -> Spec+specWithNominalScalars nominalScalars (Spec contextName moduleRoot layout ids enums rules _ mapped nodes) =+  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes++specWithIds :: [IdDecl] -> Spec -> Spec+specWithIds ids (Spec contextName moduleRoot layout _ enums rules nominalScalars mapped nodes) =+  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes++specWithIdsAndNodes :: [IdDecl] -> [Node] -> Spec -> Spec+specWithIdsAndNodes ids nodes (Spec contextName moduleRoot layout _ enums rules nominalScalars mapped _) =+  Spec contextName moduleRoot layout ids enums rules nominalScalars mapped nodes++contractNodeWithEvents :: [ContractEvent] -> ContractNode -> ContractNode+contractNodeWithEvents events (ContractNode name schemaVersion discriminator topics _ loc) =+  ContractNode name schemaVersion discriminator topics events loc++commandWithFields :: [AggregateField] -> Command -> Command+commandWithFields fields (Command name _ loc) = Command name fields loc++contractEventWithFields :: [ContractField] -> ContractEvent -> ContractEvent+contractEventWithFields fields (ContractEvent name topic _) = ContractEvent name topic fields++contractEventWithTopic :: Name -> ContractEvent -> ContractEvent+contractEventWithTopic topic (ContractEvent name _ fields) = ContractEvent name topic fields++contractFieldWithName :: Name -> ContractField -> ContractField+contractFieldWithName name (ContractField _ selector wireKey valueType loc) =+  ContractField name selector wireKey valueType loc++bindRowWithField :: Name -> BindRow -> BindRow+bindRowWithField field (BindRow _ source required crossCheck) = BindRow field source required crossCheck++wireSpecWithKind :: T.Text -> WireSpec -> WireSpec+wireSpecWithKind kind (WireSpec _ fields schemaVersion) = WireSpec kind fields schemaVersion++wireSpecWithSchemaVersion :: Int -> WireSpec -> WireSpec+wireSpecWithSchemaVersion schemaVersion (WireSpec kind fields _) = WireSpec kind fields schemaVersion++wqDispRowWithAction :: InboxAction -> WqDispRow -> WqDispRow+wqDispRowWithAction action (WqDispRow outcome _ loc) = WqDispRow outcome action loc++dispositionRowWithAction :: InboxAction -> DispositionRow -> DispositionRow+dispositionRowWithAction action (DispositionRow outcome _ loc) = DispositionRow outcome action loc++bindRowWithSource :: WireSource -> BindRow -> BindRow+bindRowWithSource source (BindRow field _ required crossCheck) = BindRow field source required crossCheck++dispatchDispositionWithOnAppended :: Disp -> DispatchDisposition -> DispatchDisposition+dispatchDispositionWithOnAppended onAppended (DispatchDisposition _ onDuplicate onFailed) =+  DispatchDisposition onAppended onDuplicate onFailed++dispatchNodeWithDisposition :: DispatchDisposition -> DispatchNode -> DispatchNode+dispatchNodeWithDisposition disposition (DispatchNode target key command fields _ loc) =+  DispatchNode target key command fields disposition loc++dispatchNodeWithKey :: T.Text -> DispatchNode -> DispatchNode+dispatchNodeWithKey key (DispatchNode target _ command fields disposition loc) =+  DispatchNode target key command fields disposition loc++fieldBindingWithValue :: Maybe T.Text -> FieldBinding -> FieldBinding+fieldBindingWithValue value (FieldBinding name _) = FieldBinding name value++projectionSpecWithKey :: Name -> ProjectionSpec -> ProjectionSpec+projectionSpecWithKey key (ProjectionSpec table consistency _ statusMap loc) =+  ProjectionSpec table consistency key statusMap loc++eventWithNameAndLoc :: Name -> Loc -> Event -> Event+eventWithNameAndLoc name loc (Event _ body version upcastFrom retiring deprecated _) =+  Event name body version upcastFrom retiring deprecated loc++eventWithBody :: EventBody -> Event -> Event+eventWithBody body (Event name _ version upcastFrom retiring deprecated loc) =+  Event name body version upcastFrom retiring deprecated loc++contextWithModuleRoot :: T.Text -> Context -> Context+contextWithModuleRoot moduleRoot (Context name _ placement) = Context name moduleRoot placement++workspaceMemberWithSpec :: Spec -> WorkspaceMember -> WorkspaceMember+workspaceMemberWithSpec spec (WorkspaceMember path _ sourceLanguage sourceIndex lineBase lineCount) =+  WorkspaceMember path spec sourceLanguage sourceIndex lineBase lineCount++workspaceWithMembersAndMergedSpec :: [WorkspaceMember] -> Spec -> WorkspaceSpec -> WorkspaceSpec+workspaceWithMembersAndMergedSpec members mergedSpec workspace =+  WorkspaceSpec+    workspace.service+    workspace.manifestPath+    workspace.languageContract+    workspace.context+    workspace.runtimePackage+    workspace.moduleRoot+    workspace.layout+    members+    mergedSpec+    workspace.sourceIndex+    workspace.lineMap+    workspace.ownership++workspaceWithMergedSpecAndOwnership :: Spec -> OwnershipIndex -> WorkspaceSpec -> WorkspaceSpec+workspaceWithMergedSpecAndOwnership mergedSpec ownership workspace =+  WorkspaceSpec+    workspace.service+    workspace.manifestPath+    workspace.languageContract+    workspace.context+    workspace.runtimePackage+    workspace.moduleRoot+    workspace.layout+    workspace.members+    mergedSpec+    workspace.sourceIndex+    workspace.lineMap+    ownership++workspaceWithOwnership :: OwnershipIndex -> WorkspaceSpec -> WorkspaceSpec+workspaceWithOwnership ownership workspace =+  workspaceWithMergedSpecAndOwnership workspace.mergedSpec ownership workspace++workspaceWithAuthority :: T.Text -> Maybe T.Text -> Maybe Placement -> WorkspaceSpec -> WorkspaceSpec+workspaceWithAuthority service moduleRoot layout workspace =+  WorkspaceSpec+    service+    workspace.manifestPath+    workspace.languageContract+    workspace.context+    workspace.runtimePackage+    moduleRoot+    layout+    workspace.members+    workspace.mergedSpec+    workspace.sourceIndex+    workspace.lineMap+    workspace.ownership++workspaceWithContextAndMergedSpec :: Name -> Spec -> WorkspaceSpec -> WorkspaceSpec+workspaceWithContextAndMergedSpec contextName mergedSpec workspace =+  WorkspaceSpec+    workspace.service+    workspace.manifestPath+    workspace.languageContract+    contextName+    workspace.runtimePackage+    workspace.moduleRoot+    workspace.layout+    workspace.members+    mergedSpec+    workspace.sourceIndex+    workspace.lineMap+    workspace.ownership++workspaceWithManifestPath :: FilePath -> WorkspaceSpec -> WorkspaceSpec+workspaceWithManifestPath manifestPath workspace =+  WorkspaceSpec+    workspace.service+    manifestPath+    workspace.languageContract+    workspace.context+    workspace.runtimePackage+    workspace.moduleRoot+    workspace.layout+    workspace.members+    workspace.mergedSpec+    workspace.sourceIndex+    workspace.lineMap+    workspace.ownership++aggregateWithName :: Name -> Aggregate -> Aggregate+aggregateWithName name (Aggregate _ regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++aggregateWithProjection :: Maybe ProjectionSpec -> Aggregate -> Aggregate+aggregateWithProjection projection (Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire _ snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++aggregateWithTransitions :: [Transition] -> Aggregate -> Aggregate+aggregateWithTransitions transitions (Aggregate name regs states commands events _ domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++aggregateWithRegs :: [RegDecl] -> Aggregate -> Aggregate+aggregateWithRegs regs (Aggregate name _ states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++aggregateWithNameAndRegs :: Name -> [RegDecl] -> Aggregate -> Aggregate+aggregateWithNameAndRegs name regs (Aggregate _ _ states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++aggregateWithCommands :: [Command] -> Aggregate -> Aggregate+aggregateWithCommands commands (Aggregate name regs states _ events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++aggregateWithStates :: [StateDecl] -> Aggregate -> Aggregate+aggregateWithStates states (Aggregate name regs _ commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++aggregateWithCommandsEventsTransitions :: [Command] -> [Event] -> [Transition] -> Aggregate -> Aggregate+aggregateWithCommandsEventsTransitions commands events transitions (Aggregate name regs states _ _ _ domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++aggregateWithWire :: Maybe WireSpec -> Aggregate -> Aggregate+aggregateWithWire wire (Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs _ projection snapshot loc) =+  Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc++regDeclWithInitial :: RegInitial -> RegDecl -> RegDecl+regDeclWithInitial initial (RegDecl name valueType _ loc) = RegDecl name valueType initial loc++regDeclWithValueType :: TypeExpr -> RegDecl -> RegDecl+regDeclWithValueType valueType (RegDecl name _ initial loc) = RegDecl name valueType initial loc++idDeclWithBinding :: Maybe NominalBindingDecl -> IdDecl -> IdDecl+idDeclWithBinding binding (IdDecl name prefix _ loc) = IdDecl name prefix binding loc++nominalBindingWithVersion :: Maybe T.Text -> NominalBindingDecl -> NominalBindingDecl+nominalBindingWithVersion bindingVersion (NominalBindingDecl haskell binding _ canonicalType fixtures initial loc) =+  NominalBindingDecl haskell binding bindingVersion canonicalType fixtures initial loc++transitionWithGuard :: Maybe Expr -> Transition -> Transition+transitionWithGuard guard (Transition source command implementation _ writes emits outcome outcomeDuplicateLocs goto mode loc) =+  Transition source command implementation guard writes emits outcome outcomeDuplicateLocs goto mode loc++transitionWithEmits :: [Name] -> Transition -> Transition+transitionWithEmits emits (Transition source command implementation guard writes _ outcome outcomeDuplicateLocs goto mode loc) =+  Transition source command implementation guard writes emits outcome outcomeDuplicateLocs goto mode loc++transitionWithImplementation :: TransitionImplementation -> Transition -> Transition+transitionWithImplementation implementation (Transition source command _ guard writes emits outcome outcomeDuplicateLocs goto mode loc) =+  Transition source command implementation guard writes emits outcome outcomeDuplicateLocs goto mode loc++transitionWithWrites :: [(Name, Expr)] -> Transition -> Transition+transitionWithWrites writes (Transition source command implementation guard _ emits outcome outcomeDuplicateLocs goto mode loc) =+  Transition source command implementation guard writes emits outcome outcomeDuplicateLocs goto mode loc++projectionOwnerWithReplay :: ProjectionReplayPolicy -> ProjectionOwnerNode -> ProjectionOwnerNode+projectionOwnerWithReplay replay (ProjectionOwnerNode name sources delivery group targets order subscription dedup checkpointOnMissing _ loc) =+  ProjectionOwnerNode name sources delivery group targets order subscription dedup checkpointOnMissing replay loc++readModelWithObservedTargets :: [Name] -> ReadModelNode -> ReadModelNode+readModelWithObservedTargets observedTargets (ReadModelNode name table schema columns version shape freshness supply group _ backingTarget queryTypes loc) =+  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc++readModelWithGroupAndObservedTargets :: Maybe Name -> [Name] -> ReadModelNode -> ReadModelNode+readModelWithGroupAndObservedTargets group observedTargets (ReadModelNode name table schema columns version shape freshness supply _ _ backingTarget queryTypes loc) =+  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc++readModelWithQueryTypes :: Maybe ReadModelQueryTypes -> ReadModelNode -> ReadModelNode+readModelWithQueryTypes queryTypes (ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget _ loc) =+  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc++workqueueWithPayload :: [WqField] -> WorkqueueNode -> WorkqueueNode+workqueueWithPayload payload (WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName _ maxRetries delay dlqOn disposition loc) =+  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc++workqueueWithName :: Name -> WorkqueueNode -> WorkqueueNode+workqueueWithName name (WorkqueueNode _ logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc) =+  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc++workqueueWithPayloadName :: Name -> WorkqueueNode -> WorkqueueNode+workqueueWithPayloadName payloadName (WorkqueueNode name logical physical dlq table ordering groupKey provision _ payload maxRetries delay dlqOn disposition loc) =+  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc++workqueueWithDelay :: T.Text -> WorkqueueNode -> WorkqueueNode+workqueueWithDelay delay (WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries _ dlqOn disposition loc) =+  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc++workqueueWithDisposition :: [WqDispRow] -> WorkqueueNode -> WorkqueueNode+workqueueWithDisposition disposition (WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn _ loc) =+  WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc++wqFieldWithValueType :: QueuePayloadType -> WqField -> WqField+wqFieldWithValueType valueType (WqField name wire _ loc) = WqField name wire valueType loc++wireFieldWithHaskell :: Name -> WireField -> WireField+wireFieldWithHaskell haskell (WireField _ key valueType presence onMissing loc) =+  WireField haskell key valueType presence onMissing loc++wireFieldWithKey :: T.Text -> WireField -> WireField+wireFieldWithKey key (WireField haskell _ valueType presence onMissing loc) =+  WireField haskell key valueType presence onMissing loc++wireFieldWithValueType :: TypeExpr -> WireField -> WireField+wireFieldWithValueType valueType (WireField haskell key _ presence onMissing loc) =+  WireField haskell key valueType presence onMissing loc++wireFieldWithPresenceAndDefault :: Presence -> Maybe OnMissing -> WireField -> WireField+wireFieldWithPresenceAndDefault presence onMissing (WireField haskell key valueType _ _ loc) =+  WireField haskell key valueType presence onMissing loc++wireFieldWithOnMissing :: Maybe OnMissing -> WireField -> WireField+wireFieldWithOnMissing onMissing (WireField haskell key valueType presence _ loc) =+  WireField haskell key valueType presence onMissing loc++wireFieldWithPresence :: Presence -> WireField -> WireField+wireFieldWithPresence presence (WireField haskell key valueType _ onMissing loc) =+  WireField haskell key valueType presence onMissing loc++contractWithSchemaVersion :: Int -> ContractNode -> ContractNode+contractWithSchemaVersion schemaVersion (ContractNode name _ discriminator topics events loc) =+  ContractNode name schemaVersion discriminator topics events loc++contractWithTopics :: [(Name, T.Text)] -> ContractNode -> ContractNode+contractWithTopics topics (ContractNode name schemaVersion discriminator _ events loc) =+  ContractNode name schemaVersion discriminator topics events loc++publisherWithOrdering :: Name -> PublisherNode -> PublisherNode+publisherWithOrdering ordering (PublisherNode name emit _ maxAttempts backoff outboxField loc) =+  PublisherNode name emit ordering maxAttempts backoff outboxField loc++publisherWithBackoff :: BackoffSpec -> PublisherNode -> PublisherNode+publisherWithBackoff backoff (PublisherNode name emit ordering maxAttempts _ outboxField loc) =+  PublisherNode name emit ordering maxAttempts backoff outboxField loc++publisherWithMaxAttempts :: Int -> PublisherNode -> PublisherNode+publisherWithMaxAttempts maxAttempts (PublisherNode name emit ordering _ backoff outboxField loc) =+  PublisherNode name emit ordering maxAttempts backoff outboxField loc++publisherWithEmit :: Name -> PublisherNode -> PublisherNode+publisherWithEmit emit (PublisherNode name _ ordering maxAttempts backoff outboxField loc) =+  PublisherNode name emit ordering maxAttempts backoff outboxField loc++publisherWithOutboxField :: Name -> PublisherNode -> PublisherNode+publisherWithOutboxField outboxField (PublisherNode name emit ordering maxAttempts backoff _ loc) =+  PublisherNode name emit ordering maxAttempts backoff outboxField loc++backoffWithKind :: Name -> BackoffSpec -> BackoffSpec+backoffWithKind kind (BackoffSpec _ window maximumValue multiplier) = BackoffSpec kind window maximumValue multiplier++backoffWithWindow :: T.Text -> BackoffSpec -> BackoffSpec+backoffWithWindow window (BackoffSpec kind _ maximumValue multiplier) = BackoffSpec kind window maximumValue multiplier++intakeWithDedupePolicy :: Name -> IntakeNode -> IntakeNode+intakeWithDedupePolicy dedupePolicy (IntakeNode name contract topic accept binds dedupeKey _ idempotence persist decode disposition loc) =+  IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition loc++intakeWithDedupeKey :: Name -> IntakeNode -> IntakeNode+intakeWithDedupeKey dedupeKey (IntakeNode name contract topic accept binds _ dedupePolicy idempotence persist decode disposition loc) =+  IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition loc++intakeWithDecode :: DecodeSpec -> IntakeNode -> IntakeNode+intakeWithDecode decode (IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist _ disposition loc) =+  IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition loc++intakeWithBinds :: [BindRow] -> IntakeNode -> IntakeNode+intakeWithBinds binds (IntakeNode name contract topic accept _ dedupeKey dedupePolicy idempotence persist decode disposition loc) =+  IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition loc++intakeWithDisposition :: [DispositionRow] -> IntakeNode -> IntakeNode+intakeWithDisposition disposition (IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode _ loc) =+  IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition loc++intakeWithContract :: Name -> IntakeNode -> IntakeNode+intakeWithContract contract (IntakeNode name _ topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition loc) =+  IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition loc++intakeWithIdempotence :: IdempotenceMode -> IntakeNode -> IntakeNode+intakeWithIdempotence idempotence (IntakeNode name contract topic accept binds dedupeKey dedupePolicy _ persist decode disposition loc) =+  IntakeNode name contract topic accept binds dedupeKey dedupePolicy idempotence persist decode disposition loc++decodeWithEnvelope :: T.Text -> DecodeSpec -> DecodeSpec+decodeWithEnvelope envelope (DecodeSpec _ bodyStrict bodySchemaVersion) = DecodeSpec envelope bodyStrict bodySchemaVersion++decodeWithBodyStrict :: Bool -> DecodeSpec -> DecodeSpec+decodeWithBodyStrict bodyStrict (DecodeSpec envelope _ bodySchemaVersion) = DecodeSpec envelope bodyStrict bodySchemaVersion++decodeWithBodySchemaVersion :: Int -> DecodeSpec -> DecodeSpec+decodeWithBodySchemaVersion bodySchemaVersion (DecodeSpec envelope bodyStrict _) = DecodeSpec envelope bodyStrict bodySchemaVersion++emitNodeWithMap :: [EmitMapRow] -> EmitNode -> EmitNode+emitNodeWithMap mapping (EmitNode name contract topic source key discriminant _ skip messageId idempotencyKey loc) =+  EmitNode name contract topic source key discriminant mapping skip messageId idempotencyKey loc++workflowWithStable :: T.Text -> WorkflowNode -> WorkflowNode+workflowWithStable stable (WorkflowNode nodeId _ input inputFields output idField idVia body loc) =+  WorkflowNode nodeId stable input inputFields output idField idVia body loc++routerWithName :: T.Text -> RouterNode -> RouterNode+routerWithName name (RouterNode nodeId _ input key resolve target projections dispatch rejected poison loc) =+  RouterNode nodeId name input key resolve target projections dispatch rejected poison loc++readModelWithVersion :: Int -> ReadModelNode -> ReadModelNode+readModelWithVersion version (ReadModelNode name table schema columns _ shape freshness supply group observedTargets backingTarget queryTypes loc) =+  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc++readModelWithName :: Name -> ReadModelNode -> ReadModelNode+readModelWithName name (ReadModelNode _ table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc) =+  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc++readModelWithTable :: T.Text -> ReadModelNode -> ReadModelNode+readModelWithTable table (ReadModelNode name _ schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc) =+  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc++readModelWithColumns :: [RmColumn] -> ReadModelNode -> ReadModelNode+readModelWithColumns columns (ReadModelNode name table schema _ version shape freshness supply group observedTargets backingTarget queryTypes loc) =+  ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc++readModelQueryTypesWithInput :: TypeExpr -> ReadModelQueryTypes -> ReadModelQueryTypes+readModelQueryTypesWithInput input (ReadModelQueryTypes _ result inputLoc resultLoc) =+  ReadModelQueryTypes input result inputLoc resultLoc++readModelQueryTypesWithResult :: TypeExpr -> ReadModelQueryTypes -> ReadModelQueryTypes+readModelQueryTypesWithResult result (ReadModelQueryTypes input _ inputLoc resultLoc) =+  ReadModelQueryTypes input result inputLoc resultLoc++processWithTimer :: TimerNode -> ProcessNode -> ProcessNode+processWithTimer timer process = case (.body) process of+  LegacyProcessBody input handle _ -> process {body = LegacyProcessBody input handle timer}+  ReactionProcessBody {} -> process++processWithHandle :: HandleNode -> ProcessNode -> ProcessNode+processWithHandle handle process = case (.body) process of+  LegacyProcessBody input _ timer -> process {body = LegacyProcessBody input handle timer}+  ReactionProcessBody {} -> process++processWithSaga :: SagaRef -> ProcessNode -> ProcessNode+processWithSaga saga process = process {saga = saga}++processWithCorrelate :: CorrelateDecl -> ProcessNode -> ProcessNode+processWithCorrelate correlate process = process {correlate = correlate}++legacyProcessHandle :: ProcessNode -> HandleNode+legacyProcessHandle process = case (.body) process of+  LegacyProcessBody _ handle _ -> handle+  ReactionProcessBody {} -> error "test invariant: expected legacy process handle"++legacyProcessTimer :: ProcessNode -> TimerNode+legacyProcessTimer process = case (.body) process of+  LegacyProcessBody _ _ timer -> timer+  ReactionProcessBody {} -> error "test invariant: expected legacy process timer"  sagaRefWithCategory :: T.Text -> SagaRef -> SagaRef sagaRefWithCategory category (SagaRef agg _) = SagaRef agg category
test/conformance-aggregate-scalars/Generated/AggregateScalars/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context aggregate-scalars behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context aggregate-scalars behavior source map; do not edit. module Generated.AggregateScalars.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-aggregate-scalars/Generated/AggregateScalars/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context aggregate-scalars replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context aggregate-scalars replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/BehaviorContract.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit. module Generated.AggregateScalars.ScalarLedger.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit. module Generated.AggregateScalars.ScalarLedger.Codec (     scalarLedgerCodec,     parseScalarLedgerEvent,
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Domain.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit. module Generated.AggregateScalars.ScalarLedger.Domain where  import Data.Aeson (FromJSON, ToJSON)
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit. module Generated.AggregateScalars.ScalarLedger.EventStream   ( scalarLedgerCategory   , scalarLedgerCommandCategory
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Harness.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit. module Generated.AggregateScalars.ScalarLedger.Harness (harnessAssertions) where  import Generated.AggregateScalars.ScalarLedger.Domain
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit. module Generated.AggregateScalars.ScalarLedger.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit. module Generated.AggregateScalars.ScalarLedger.Transducer   ( scalarLedgerTransducer   , scalarLedgerFoldFingerprint
test/conformance-baseline.json view
@@ -1,8 +1,8 @@ {   "schema": "keiro-dsl/conformance-baseline/2",   "stableLanguageVersion": 5,-  "authoringLanguageVersion": 5,-  "primaryLanguageVersions": [4, 5],+  "authoringLanguageVersion": 6,+  "primaryLanguageVersions": [4, 5, 6],   "fixtureExceptions": [     {"path": "test/fixtures/aggregate-collection-expressions-v2-rejects.keiro", "sourceForm": "declared", "effectiveVersion": 2, "role": "compatibility-proof", "reason": "version-2 grammar rejection vector"},     {"path": "test/fixtures/aggregate-scalar-expressions-v1-rejects.keiro", "sourceForm": "declared", "effectiveVersion": 1, "role": "compatibility-proof", "reason": "version-1 predecessor feature rejection vector"},@@ -27,8 +27,9 @@     {"component": "keiro-dsl-conformance-domain-outcomes", "directory": "test/conformance-domain-outcomes", "source": "test/fixtures/domain-command-outcomes.keiro", "generation": "source", "role": "stable-primary", "languageVersion": 5, "reason": "stable typed domain outcome handler and exact silent-reason proof"},     {"component": "keiro-dsl-conformance-import-planning", "directory": "test/conformance-import-planning", "source": "test/fixtures/import-planning-collisions.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 consumer import collision and alias proof"},     {"component": "keiro-dsl-conformance-nominal-scalars", "directory": "test/conformance-nominal-scalars", "source": "test/fixtures/nominal-scalars.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 nominal scalar codec proof"},-    {"component": "keiro-dsl-conformance-workspace-nominals", "directory": "test/conformance-workspace-nominals", "source": "test/fixtures/workspace-nominals/service.keiro-workspace", "generation": "workspace", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 workspace-owned nominal proof"},+    {"component": "keiro-dsl-conformance-workspace-nominals", "directory": "test/conformance-workspace-nominals", "source": "test/fixtures/workspace-nominals/service.keiro-workspace", "generation": "workspace", "role": "candidate-primary", "languageVersion": 6, "reason": "candidate Language 6 cross-member structural nominal ownership proof"},     {"component": "keiro-dsl-conformance-structural", "directory": "test/conformance-structural", "source": "test/fixtures/structural-conformance.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 structural mapping proof"},+    {"component": "keiro-dsl-conformance-structural-nominals", "directory": "test/conformance-structural-nominals", "source": "test/fixtures/structural-nominal-leaves.keiro", "generation": "source", "role": "candidate-primary", "languageVersion": 6, "reason": "candidate Language 6 structural nominal admission proof"},     {"component": "keiro-dsl-conformance-mapped-queue", "directory": "test/conformance-mapped-queue", "source": "test/fixtures/mapped-workqueue.keiro", "generation": "source", "role": "stable-primary", "languageVersion": 5, "reason": "stable mapped workqueue structural, opaque, required-nullable, and schema-version-1 envelope proof"},     {"component": "keiro-dsl-conformance-mapped-readmodel", "directory": "test/conformance-mapped-readmodel", "source": "test/fixtures/mapped-readmodel.keiro", "generation": "source", "role": "stable-primary", "languageVersion": 5, "reason": "stable mapped read-model query contract, workspace provenance, and projection catalog proof"},     {"component": "keiro-dsl-conformance-codec-compare", "directory": "test/conformance-codec-compare", "source": null, "generation": "none", "role": "version-independent", "reason": "codec comparison helper proof has no source-language fixture"},@@ -37,8 +38,10 @@     {"component": "keiro-dsl-conformance-skeletons", "directory": "test/conformance-skeletons", "source": null, "generation": "none", "role": "compatibility-proof", "reason": "compiled released-language-4 skeleton corpus retained without unrelated banner rewrites"},     {"component": "keiro-dsl-conformance-coldstart", "directory": "test/conformance-coldstart", "source": "test/fixtures/subscription.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 cold-start subscription proof"},     {"component": "keiro-dsl-conformance-contract", "directory": "test/conformance-contract", "source": "test/fixtures/contract-v4.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 typed contract and field-identity selector/wire-key proof"},+    {"component": "keiro-dsl-conformance-contract-declared-id", "directory": "test/conformance-contract-declared-id", "source": "test/fixtures/contract-declared-id.keiro", "generation": "source", "role": "candidate-primary", "languageVersion": 6, "reason": "candidate Language 6 declared generated-ID and consumer-bound-ID contract proof"},     {"component": "keiro-dsl-conformance-contract-v1-compat", "directory": "test/conformance-contract-v1-compat", "source": "test/fixtures/contract-v1-compat.keiro", "generation": "none", "role": "compatibility-proof", "reason": "version-1 permissive Text contract compatibility proof"},     {"component": "keiro-dsl-conformance-intake-runtime", "directory": "test/conformance-intake-runtime", "source": "test/fixtures/intake.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 intake runtime proof"},+    {"component": "keiro-dsl-conformance-intake-delegated", "directory": "test/conformance-intake-delegated", "source": "test/fixtures/intake-delegated.keiro", "generation": "source", "role": "candidate-primary", "languageVersion": 6, "reason": "candidate Language 6 delegated runner and no-Store hand-filled integration proof"},     {"component": "keiro-dsl-conformance-intake-full", "directory": "test/conformance-intake-full", "source": "test/fixtures/intake.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 complete intake scaffold proof"},     {"component": "keiro-dsl-conformance-publisher-runtime", "directory": "test/conformance-publisher-runtime", "source": "test/fixtures/emit.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 publisher runtime proof"},     {"component": "keiro-dsl-conformance-queue", "directory": "test/conformance-queue", "source": "test/fixtures/reservation-work.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 workqueue scaffold proof"},@@ -51,6 +54,9 @@     {"component": "keiro-dsl-conformance-process-full", "directory": "test/conformance-process-full", "source": "test/fixtures/surge-service.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 complete process scaffold proof"},     {"component": "keiro-dsl-conformance-workflow-full", "directory": "test/conformance-workflow-full", "source": "test/fixtures/workflow-evolution.keiro", "generation": "source", "role": "stable-primary", "languageVersion": 5, "reason": "complete stable Language 5 workflow scaffold proof"},     {"component": "keiro-dsl-conformance-process-runtime", "directory": "test/conformance-process-runtime", "source": "test/fixtures/hospital-surge.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 process runtime proof"},+    {"component": "keiro-dsl-conformance-process-reactions", "directory": "test/conformance-process-reactions", "source": "test/fixtures/process-reactions.keiro", "generation": "source", "role": "candidate-primary", "languageVersion": 6, "reason": "candidate Language 6 guarded reactions, no-action worker acknowledgement, target fan-out, and durable redelivery proof"},+    {"component": "keiro-dsl-conformance-process-timers", "directory": "test/conformance-process-timers", "source": "test/fixtures/process-timers.keiro", "generation": "source", "role": "candidate-primary", "languageVersion": 6, "reason": "candidate Language 6 typed timer payload, rearm/once/cancel accounting, and deterministic firing proof"},+    {"component": "keiro-dsl-conformance-process-state-authority", "directory": "test/conformance-process-state-authority", "source": "test/fixtures/process-state-authority.keiro", "generation": "source", "role": "candidate-primary", "languageVersion": 6, "reason": "candidate Language 6 saga acceptance authority, accepted-only fan-out, no-advance, and partial-success recovery proof"},     {"component": "keiro-dsl-conformance-router-runtime", "directory": "test/conformance-router-runtime", "source": "test/fixtures/incident-paging/incident-paging.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 router runtime proof"},     {"component": "keiro-dsl-conformance-declarative-router", "directory": "test/conformance-declarative-router", "source": "test/fixtures/declarative-router/valid.keiro", "generation": "source", "role": "stable-primary", "languageVersion": 5, "reason": "stable checked declarative selection, normalization, redelivery, conflict, and PostgreSQL query proof"},     {"component": "keiro-dsl-conformance-router", "directory": "test/conformance-router", "source": "test/fixtures/incident-paging/incident-paging.keiro", "generation": "source", "role": "published-compatibility", "languageVersion": 4, "reason": "published Language 4 router scaffold proof"},
test/conformance-behavior-complete/Generated/BehaviorComplete/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context behavior-complete behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context behavior-complete behavior source map; do not edit. module Generated.BehaviorComplete.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/BehaviorContract.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit. module Generated.BehaviorComplete.Journey.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit. module Generated.BehaviorComplete.Journey.Codec (     journeyCodec,     parseJourneyEvent,@@ -42,7 +42,7 @@ encodeStartPayloadShape shape =   object       [ "display_label" .= toJSON (shape.label)-      , "optional_note" .= maybe Null (\item -> toJSON (item)) (shape.note)+      , "optional_note" .= maybe Null (\item0 -> toJSON (item0)) (shape.note)       ]  parseStartPayloadShape :: Value -> Parser ShapeStartPayload.StartPayloadShape@@ -50,7 +50,7 @@   rejectUnknownFields "StartPayload" ["display_label", "optional_note"] objectValue   ShapeStartPayload.StartPayload     <$> explicitParseField (parseJSON) objectValue "display_label"-    <*> parseOptionalField (pure Nothing) (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) objectValue "optional_note"+    <*> parseOptionalField (pure Nothing) (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseJSON) other0) objectValue "optional_note"  journeyEventTypes :: NonEmpty EventType journeyEventTypes = EventType "Started" :| [EventType "DecisionRecorded", EventType "Retired", EventType "RetirementAudited", EventType "LegacyStarted"]
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Domain.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit. module Generated.BehaviorComplete.Journey.Domain where  import Data.Aeson (FromJSON, ToJSON)
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit. module Generated.BehaviorComplete.Journey.EventStream   ( journeyCategory   , journeyCommandCategory
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Harness.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit. module Generated.BehaviorComplete.Journey.Harness (harnessAssertions) where  import Generated.BehaviorComplete.Journey.Domain
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit. module Generated.BehaviorComplete.Journey.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit. module Generated.BehaviorComplete.Journey.Transducer   ( journeyTransducer   , journeyFoldFingerprint
test/conformance-behavior-complete/Generated/BehaviorComplete/Nominals.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context behavior-complete generated nominal declarations; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context behavior-complete generated nominal declarations; do not edit. module Generated.BehaviorComplete.Nominals   ( RequestId   , parseRequestId
test/conformance-behavior-complete/Generated/BehaviorComplete/Nominals/Internal.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context behavior-complete generated nominal ID internals; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context behavior-complete generated nominal ID internals; do not edit. module Generated.BehaviorComplete.Nominals.Internal   ( RequestId   , parseRequestId
test/conformance-behavior-complete/Generated/BehaviorComplete/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context behavior-complete replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context behavior-complete replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-behavior-complete/Generated/BehaviorComplete/Structural/Shape/StartPayload.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from mapped structural StartPayload; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from mapped structural StartPayload; do not edit. module Generated.BehaviorComplete.Structural.Shape.StartPayload (StartPayloadShape (..)) where  import Data.Text (Text)
test/conformance-behavior-complete/Generated/BehaviorComplete/StructuralConformance.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context behavior-complete structural conformance; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context behavior-complete structural conformance; do not edit. module Generated.BehaviorComplete.StructuralConformance   ( structuralConformanceAssertions   ) where@@ -12,7 +12,7 @@ import Keiki.Shape (CanonicalTypeName (..)) import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape) import Generated.BehaviorComplete.StructuralProjections qualified as StructuralProjections-import Generated.BehaviorComplete.Structural.Shape.StartPayload (StartPayloadShape(label, note))+import Generated.BehaviorComplete.Structural.Shape.StartPayload (StartPayloadShape(note)) import BehaviorComplete.Bindings qualified as Bindings import BehaviorComplete.Domain (StartPayload) @@ -50,5 +50,5 @@  structuralProjectionAssertions :: [(String, Bool)] structuralProjectionAssertions =-  [ ("projection witness agreement: behavior-complete.StartPayload.v1/display_label", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.startPayloadDisplayLabelWitness (\referenceOwner -> (bindingToShape Bindings.startPayloadBinding referenceOwner).label) owner) (NonEmpty.toList (fixtureCases Bindings.startPayloadCases)))+  [ ("projection witness agreement: behavior-complete.StartPayload.v1/display_label", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.startPayloadDisplayLabelWitness (\referenceOwner -> StructuralProjections.startPayloadDisplayLabelGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.startPayloadCases)))   ]
test/conformance-behavior-complete/Generated/BehaviorComplete/StructuralProjections.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE TypeFamilies #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context behavior-complete mapped structural facade; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context behavior-complete mapped structural facade; do not edit. -- Equality witnesses are emitted for Text, Int, Bool, Natural, and UTCTime.+-- Nominal ID and enum leaves carry exact canonical-text domains. -- Int, Natural, and UTCTime belong to Keiki's ordered subset. module Generated.BehaviorComplete.StructuralProjections   ( startPayloadDisplayLabelWitness+  , startPayloadDisplayLabelGet   ) where  import Data.Text (Text)@@ -15,12 +17,15 @@  data StartPayloadDisplayLabelProjection +startPayloadDisplayLabelGet :: StartPayload -> Text+startPayloadDisplayLabelGet owner = (bindingToShape Bindings.startPayloadBinding owner).label+ instance FieldProjection StartPayloadDisplayLabelProjection where   type FieldName StartPayloadDisplayLabelProjection = "/display_label"   type FieldOwner StartPayloadDisplayLabelProjection = StartPayload   type FieldResult StartPayloadDisplayLabelProjection = Text   fieldShapeId _ = "behavior-complete.StartPayload.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.startPayloadBinding owner).label+  projectFieldValue _ = startPayloadDisplayLabelGet  startPayloadDisplayLabelWitness :: FieldWitness StartPayloadDisplayLabelProjection startPayloadDisplayLabelWitness = fieldWitness @StartPayloadDisplayLabelProjection
test/conformance-coldstart/Generated/Billing/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context billing behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context billing behavior source map; do not edit. module Generated.Billing.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-coldstart/Generated/Billing/Nominals.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TypeFamilies #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context billing generated nominal declarations; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context billing generated nominal declarations; do not edit. module Generated.Billing.Nominals   ( CustomerId   , parseCustomerId
test/conformance-coldstart/Generated/Billing/Nominals/Internal.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context billing generated nominal ID internals; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context billing generated nominal ID internals; do not edit. module Generated.Billing.Nominals.Internal   ( CustomerId   , parseCustomerId
test/conformance-coldstart/Generated/Billing/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context billing replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context billing replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-coldstart/Generated/Billing/Subscription/BehaviorContract.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit. module Generated.Billing.Subscription.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-coldstart/Generated/Billing/Subscription/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit. module Generated.Billing.Subscription.Codec (     subscriptionCodec,     parseSubscriptionEvent,
test/conformance-coldstart/Generated/Billing/Subscription/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit. module Generated.Billing.Subscription.Domain where  import Data.Proxy (Proxy (..))
test/conformance-coldstart/Generated/Billing/Subscription/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit. module Generated.Billing.Subscription.EventStream   ( subscriptionCategory   , subscriptionCommandCategory
test/conformance-coldstart/Generated/Billing/Subscription/Harness.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit. module Generated.Billing.Subscription.Harness (harnessAssertions) where  import Generated.Billing.Subscription.Domain
test/conformance-coldstart/Generated/Billing/Subscription/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit. module Generated.Billing.Subscription.Projection   ( subscriptionsProjection   , subscriptionsStatusFor
test/conformance-coldstart/Generated/Billing/Subscription/Transducer.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Subscription; do not edit. module Generated.Billing.Subscription.Transducer   ( subscriptionTransducer   , subscriptionFoldFingerprint
+ test/conformance-contract-declared-id/Conformance/ContractDeclaredId/Bindings.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module Conformance.ContractDeclaredId.Bindings where++import Conformance.ContractDeclaredId.Domain+import Data.Aeson (Value (String))+import Data.KindID qualified as KindID+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import Keiro.Codec.Nominal (NominalBinding (..), NominalFixture (..), NominalFixtureCases (..))++claimIdText :: Text+claimIdText = "claim_01h455vb4pex5vsknk084sn02q"++claimId :: ClaimId+claimId = case KindID.parseText @"claim" claimIdText of+  Left reason -> error ("invalid committed ClaimId fixture: " <> show reason)+  Right value -> ClaimId value++claimIdBinding :: NominalBinding ClaimId (KindID.KindID "claim")+claimIdBinding = NominalBinding unClaimId ClaimId++claimIdFixtures :: NominalFixtureCases ClaimId+claimIdFixtures = NominalFixtureCases (NominalFixture "claim" (String claimIdText) claimId :| [])
+ test/conformance-contract-declared-id/Conformance/ContractDeclaredId/Domain.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Conformance.ContractDeclaredId.Domain where++import Data.KindID (KindID)+import Data.Proxy (Proxy)+import Data.Text (Text)+import Keiki.Shape (CanonicalTypeName (..))++newtype ClaimId = ClaimId (KindID "claim")+  deriving newtype (Eq, Ord, Show)++unClaimId :: ClaimId -> KindID "claim"+unClaimId (ClaimId value) = value++instance CanonicalTypeName ClaimId where+  canonicalTypeName :: Proxy ClaimId -> Text+  canonicalTypeName _ = "conformance.contract-declared-id.ClaimId.v1"
+ test/conformance-contract-declared-id/Generated/ContractDeclaredId/Nominals.hs view
@@ -0,0 +1,9 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context contract-declared-id generated nominal declarations; do not edit.+module Generated.ContractDeclaredId.Nominals+  ( TemplateId+  , parseTemplateId+  , mkTemplateId+  , templateIdText+  ) where++import Generated.ContractDeclaredId.Nominals.Internal (TemplateId, mkTemplateId, parseTemplateId, templateIdText)
+ test/conformance-contract-declared-id/Generated/ContractDeclaredId/Nominals/Internal.hs view
@@ -0,0 +1,40 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context contract-declared-id generated nominal ID internals; do not edit.+module Generated.ContractDeclaredId.Nominals.Internal+  ( TemplateId+  , parseTemplateId+  , mkTemplateId+  , templateIdText+  , unsafeTemplateIdFromLegacyText+  ) 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)++newtype TemplateId = TemplateId Text+  deriving stock (Generic, Eq, Ord, Show)++instance CanonicalTypeName TemplateId++instance ToJSON TemplateId where+  toJSON = toJSON . templateIdText++instance FromJSON TemplateId where+  parseJSON = withText "TemplateId" (either (fail . T.unpack) pure . parseTemplateId)++parseTemplateId :: Text -> Either Text TemplateId+parseTemplateId input = case validateIdDomainText (typeIdV7Domain "template") input of+  Left reason -> Left (T.pack (show reason))+  Right () -> Right (TemplateId input)++mkTemplateId :: Text -> Either Text TemplateId+mkTemplateId = parseTemplateId++templateIdText :: TemplateId -> Text+templateIdText (TemplateId value) = value++unsafeTemplateIdFromLegacyText :: Text -> TemplateId+unsafeTemplateIdFromLegacyText = TemplateId
+ test/conformance-contract-declared-id/Generated/ContractDeclaredId/Structural/NominalLeaves.hs view
@@ -0,0 +1,31 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context contract-declared-id structural nominal leaves; do not edit.+module Generated.ContractDeclaredId.Structural.NominalLeaves where++import Data.Aeson (Value (..), withText)+import Data.Aeson.Types (Parser)+import Data.KindID qualified as KindID+import Data.Text qualified as T+import Keiro.Codec.IdDomain (parseKindIdV7Text)+import Keiro.Codec.Nominal (nominalFromRepresentation, nominalToRepresentation)+import Conformance.ContractDeclaredId.Bindings qualified as Bindings+import Conformance.ContractDeclaredId.Domain (ClaimId)+import Generated.ContractDeclaredId.Nominals qualified as Nominals++encodeClaimIdLeaf :: ClaimId -> Value+encodeClaimIdLeaf = String . KindID.toText . nominalToRepresentation Bindings.claimIdBinding+{-# NOINLINE encodeClaimIdLeaf #-}++parseClaimIdLeaf :: Value -> Parser ClaimId+parseClaimIdLeaf = withText "ClaimId" $ \input ->+  case parseKindIdV7Text @"claim" input of+    Left reason -> fail (show reason)+    Right representation -> pure (nominalFromRepresentation Bindings.claimIdBinding representation)+{-# NOINLINE parseClaimIdLeaf #-}++encodeTemplateIdLeaf :: Nominals.TemplateId -> Value+encodeTemplateIdLeaf = String . Nominals.templateIdText+{-# NOINLINE encodeTemplateIdLeaf #-}++parseTemplateIdLeaf :: Value -> Parser Nominals.TemplateId+parseTemplateIdLeaf = withText "TemplateId" (either (fail . T.unpack) pure . Nominals.parseTemplateId)+{-# NOINLINE parseTemplateIdLeaf #-}
+ test/conformance-contract-declared-id/Generated/ContractDeclaredId/StructuralConformance.hs view
@@ -0,0 +1,26 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context contract-declared-id structural conformance; do not edit.+module Generated.ContractDeclaredId.StructuralConformance+  ( structuralConformanceAssertions+  ) where++import Data.List.NonEmpty qualified as NonEmpty+import Data.Proxy (Proxy (..))+import Keiki.Shape (CanonicalTypeName (..))+import Keiro.Codec.Nominal (nominalDomainRoundTrip, nominalFixtureCases, nominalFixtureDomain, nominalRepresentationRoundTrip, nominalToRepresentation)+import Conformance.ContractDeclaredId.Bindings qualified as Bindings+import Conformance.ContractDeclaredId.Domain (ClaimId)++structuralConformanceAssertions :: [(String, Bool)]+structuralConformanceAssertions =+  concat+    [ claimIdNominalAssertions+    ]++claimIdNominalAssertions :: [(String, Bool)]+claimIdNominalAssertions =+  [ ("nominal domain law: ClaimId", all (nominalDomainRoundTrip Bindings.claimIdBinding . nominalFixtureDomain) cases)+  , ("nominal representation law: ClaimId", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip Bindings.claimIdBinding (nominalToRepresentation Bindings.claimIdBinding domainValue)) cases)+  , ("nominal canonical identity: ClaimId", canonicalTypeName (Proxy @ClaimId) == "conformance.contract-declared-id.ClaimId.v1")+  ]+  where+    cases = NonEmpty.toList (nominalFixtureCases Bindings.claimIdFixtures)
+ test/conformance-contract-declared-id/Generated/ContractDeclaredId/Templates/Contract.hs view
@@ -0,0 +1,69 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from contract templates; do not edit.+module Generated.ContractDeclaredId.Templates.Contract+  ( TemplatesPayload (..)+  , TemplateClaimedData (..)+  , templateEventsTopic+  , messageTypeOf+  , encodeTemplatesPayload+  , parseTemplatesPayload+  ) where++import Data.Aeson (Value, object, withObject, withText, (.=))+import Data.Aeson.Types (Parser, explicitParseField, parseEither)+import Data.KindID (KindID)+import qualified Data.KindID as KindID+import Conformance.ContractDeclaredId.Domain (ClaimId)+import Generated.ContractDeclaredId.Nominals qualified as Nominals+import Generated.ContractDeclaredId.Structural.NominalLeaves qualified as NominalLeaves+import Data.Text (Text)+import qualified Data.Text as T+import Keiro.Codec.IdDomain (parseKindIdV7Value)++-- topic constants+templateEventsTopic :: Text+templateEventsTopic = "templates.events"++-- the closed payload set (discriminated by "messageType")+data TemplateClaimedData = TemplateClaimedData {templateId :: !Nominals.TemplateId, claimId :: !ClaimId, legacyTemplateId :: !(KindID "template")}+  deriving stock (Eq, Show)++data TemplatesPayload+  = TemplateClaimed !TemplateClaimedData+  deriving stock (Eq, Show)++messageTypeOf :: TemplatesPayload -> Text+messageTypeOf = \case+  TemplateClaimed {} -> "TemplateClaimed"++encodeTemplatesPayload :: TemplatesPayload -> Value+encodeTemplatesPayload = \case+  TemplateClaimed payload ->+    object+      [ "messageType" .= ("TemplateClaimed" :: Text),+        "templateId" .= NominalLeaves.encodeTemplateIdLeaf payload.templateId,+        "claimId" .= NominalLeaves.encodeClaimIdLeaf payload.claimId,+        "legacyTemplateId" .= KindID.toText payload.legacyTemplateId+      ]++parseTemplatesPayload :: Value -> Either Text TemplatesPayload+parseTemplatesPayload = mapLeftText . parseEither (withObject "TemplatesPayload" go)+  where+    go o = do+      kind <- explicitParseField (withText "messageType" validateMessageType) o "messageType"+      case kind of+        "TemplateClaimed" ->+          TemplateClaimed+            <$> ( TemplateClaimedData+                    <$> explicitParseField NominalLeaves.parseTemplateIdLeaf o "templateId"+                    <*> explicitParseField NominalLeaves.parseClaimIdLeaf o "claimId"+                    <*> explicitParseField (parseKindIdV7Value @"template") o "legacyTemplateId"+                )+        _ -> 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` ["TemplateClaimed"] = pure kind+  | otherwise = fail ("unknown message type " <> show kind <> "; expected one of: TemplateClaimed")
+ test/conformance-contract-declared-id/Main.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Main (main) where++import Conformance.ContractDeclaredId.Bindings (claimId, claimIdText)+import Data.Aeson (Value (Object), object, (.=))+import Data.Aeson.KeyMap qualified as KeyMap+import Data.KindID qualified as KindID+import Data.Text (Text)+import Data.Text qualified as T+import Generated.ContractDeclaredId.Nominals (TemplateId, parseTemplateId)+import Generated.ContractDeclaredId.StructuralConformance (structuralConformanceAssertions)+import Generated.ContractDeclaredId.Templates.Contract+import System.Exit (exitFailure)++canonicalSuffix :: Text+canonicalSuffix = "01h455vb4pex5vsknk084sn02q"++templateIdText :: Text+templateIdText = "template_" <> canonicalSuffix++templateIdValue :: TemplateId+templateIdValue = either (error . T.unpack) id (parseTemplateId templateIdText)++legacyTemplateIdValue :: KindID.KindID "template"+legacyTemplateIdValue = either (error . show) id (KindID.parseText @"template" templateIdText)++payload :: TemplatesPayload+payload = TemplateClaimed (TemplateClaimedData templateIdValue claimId legacyTemplateIdValue)++payloadJson :: Text -> Value+payloadJson rawClaimId =+  object+    [ "messageType" .= ("TemplateClaimed" :: Text),+      "templateId" .= templateIdText,+      "claimId" .= rawClaimId,+      "legacyTemplateId" .= templateIdText+    ]++main :: IO ()+main = do+  let encoded = encodeTemplatesPayload payload+      checks =+        [ ("declared contract IDs round-trip", encoded == payloadJson claimIdText && parseTemplatesPayload encoded == Right payload),+          ("literal and declared forms retain identical JSON text", equalTemplateFields encoded),+          ("wrong-prefix consumer ID is rejected at $.claimId", rejectsWrongPrefix),+          ("contract-only nominal conformance", all snd structuralConformanceAssertions)+        ]+  mapM_ (\(label, ok) -> putStrLn ((if ok then "PASS  " else "FAIL  ") <> label)) checks+  let failed = [label | (label, ok) <- checks, not ok]+  if null failed then pure () else putStrLn ("declared-ID contract: failed " <> show failed) >> exitFailure+  where+    equalTemplateFields (Object fields) = KeyMap.lookup "templateId" fields == KeyMap.lookup "legacyTemplateId" fields+    equalTemplateFields _ = False+    rejectsWrongPrefix = case parseTemplatesPayload (payloadJson ("template_" <> canonicalSuffix)) of+      Left problem -> "$.claimId" `T.isInfixOf` problem+      Right _ -> False
+ test/conformance-contract-declared-id/keiro-dsl-cabal-fragment.context.contract-declared-id.txt view
@@ -0,0 +1,34 @@+-- keiro-dsl build manifest for keiro-dsl/test/fixtures/contract-declared-id.keiro+-- Paste the complete fragment below into the consuming Cabal stanza.+-- The generated layer is overwritten on every scaffold; hole modules are+-- create-if-absent (filled by hand).++default-language: GHC2024+default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings++other-modules:+    Conformance.ContractDeclaredId.Bindings+    Generated.ContractDeclaredId.Nominals+    Generated.ContractDeclaredId.Nominals.Internal+    Generated.ContractDeclaredId.Structural.NominalLeaves+    Generated.ContractDeclaredId.StructuralConformance+    Generated.ContractDeclaredId.Templates.Contract++build-depends:+    , aeson+    , base+    , keiro-core+    , keiro-dsl+    , mmzk-typeid+    , text++consumer-packages:+    keiro-dsl++consumer-modules:+    Conformance.ContractDeclaredId.Bindings+    Conformance.ContractDeclaredId.Domain
+ test/conformance-contract-declared-id/keiro-dsl-ledger.context.contract-declared-id.txt view
@@ -0,0 +1,30 @@+keiro-dsl scaffold record v1+spec: keiro-dsl/test/fixtures/contract-declared-id.keiro+module-root: (none)+layout: prefixed+source-language {"declaredLanguageVersion":6,"effectiveLanguageVersion":6,"sourceForm":"declared"}+semantic-contract {"languageSupport":"candidate","languageVersion":6,"runtimeSemantics":"keiro-dsl/runtime-semantics/5"}+naming-edition idiomatic-v2+module-role {"family":"StructuralConformance","kind":"generated","ownerKind":"context","ownerName":"context contract-declared-id structural conformance","path":"Generated/ContractDeclaredId/StructuralConformance.hs"}+module-role {"family":"Nominals","kind":"generated","ownerKind":"context","ownerName":"context contract-declared-id generated nominal declarations","path":"Generated/ContractDeclaredId/Nominals.hs"}+module-role {"family":"Internal","kind":"generated","ownerKind":"context","ownerName":"context contract-declared-id generated nominal ID internals","path":"Generated/ContractDeclaredId/Nominals/Internal.hs"}+module-role {"family":"NominalLeaves","kind":"generated","ownerKind":"context","ownerName":"context contract-declared-id structural nominal leaves","path":"Generated/ContractDeclaredId/Structural/NominalLeaves.hs"}+module-role {"family":"Bindings","kind":"hole","ownerKind":"consumer","ownerName":"consumer binding skeleton Conformance.ContractDeclaredId.Bindings","path":"Conformance/ContractDeclaredId/Bindings.hs"}+module-role {"family":"Contract","kind":"generated","ownerKind":"contract","ownerName":"contract templates (line 14)","path":"Generated/ContractDeclaredId/Templates/Contract.hs"}+generated Generated/ContractDeclaredId/StructuralConformance.hs+generated Generated/ContractDeclaredId/Nominals.hs+generated Generated/ContractDeclaredId/Nominals/Internal.hs+generated Generated/ContractDeclaredId/Structural/NominalLeaves.hs+hole Conformance/ContractDeclaredId/Bindings.hs+generated Generated/ContractDeclaredId/Templates/Contract.hs+nominal-mapping {"bindingSymbol":"Conformance.ContractDeclaredId.Bindings.claimIdBinding","bindingVersion":"1","canonicalType":"conformance.contract-declared-id.ClaimId.v1","category":"id","fixtureSymbol":"Conformance.ContractDeclaredId.Bindings.claimIdFixtures","initialSymbol":null,"mode":"nominal","module":"Conformance.ContractDeclaredId.Domain","package":"keiro-dsl","representation":"KindID:claim","schema":1,"specName":"ClaimId","type":"ClaimId"}+id-domain id-domain|name=TemplateId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=template|separator=_|json=canonical-json-text+id-domain id-domain|name=ClaimId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=claim|separator=_|json=canonical-json-text+id-domain id-domain|name=contract:templates.TemplateClaimed.templateId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=template|separator=_|json=canonical-json-text+id-domain id-domain|name=contract:templates.TemplateClaimed.claimId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=claim|separator=_|json=canonical-json-text+id-domain id-domain|name=contract:templates.TemplateClaimed.legacyTemplateId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=template|separator=_|json=canonical-json-text+nominal-equality nominal-equality|name=ClaimId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:claim:keiro-dsl/id-domain/typeid-v7/1|owner=consumer;canonical=conformance.contract-declared-id.ClaimId.v1;binding=Conformance.ContractDeclaredId.Bindings.claimIdBinding;binding-version=1+nominal-equality nominal-equality|name=TemplateId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:template:keiro-dsl/id-domain/typeid-v7/1|owner=generated+binding {"kind":"binding","mappedName":"ClaimId","module":"Conformance.ContractDeclaredId.Bindings","path":null,"schema":1,"signature":"claimIdBinding :: NominalBinding Conformance.ContractDeclaredId.Domain.ClaimId (KindID \"claim\")","symbol":"claimIdBinding"}+binding {"kind":"fixtures","mappedName":"ClaimId","module":"Conformance.ContractDeclaredId.Bindings","path":null,"schema":1,"signature":"claimIdFixtures :: NominalFixtureCases Conformance.ContractDeclaredId.Domain.ClaimId","symbol":"claimIdFixtures"}+semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
test/conformance-contract-v1-compat/Generated/HospitalCapacity/Emergency/Contract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 1) from contract emergency; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 1) from contract emergency; do not edit. module Generated.HospitalCapacity.Emergency.Contract   ( EmergencyPayload (..)   , IncidentTransferNeedDeclaredData (..)
test/conformance-contract/Generated/HospitalCapacity/Emergency/Contract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from contract emergency; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from contract emergency; do not edit. module Generated.HospitalCapacity.Emergency.Contract   ( EmergencyPayload (..)   , IncidentTransferNeedDeclaredData (..)
test/conformance-corpus-manifest.txt view
@@ -15,6 +15,7 @@ frozen keiro-dsl/test/conformance-skeletons  extra-args keiro-dsl/test/conformance-structural --codec-comparison ArtifactInfo --comparison-out keiro-dsl/test/conformance-structural/Generated/StructuralConformance/Structural/CodecCompare/ArtifactInfo.hs+extra-args keiro-dsl/test/conformance-structural-nominals --codec-comparison TemplateState --comparison-out keiro-dsl/test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Structural/CodecCompare/TemplateState.hs  # Reviewed legacy suites intentionally compile only the output surface under test. uncompiled-generated keiro-dsl/test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/BehaviorContract.hs@@ -51,6 +52,34 @@ uncompiled-generated keiro-dsl/test/conformance-process-runtime/Generated/HospitalCapacity/Surge/BehaviorContract.hs uncompiled-generated keiro-dsl/test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Harness.hs uncompiled-generated keiro-dsl/test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Projection.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/AuditOnly/ProcessHarness.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/BehaviorSourceMap.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/Incident/BehaviorContract.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/Incident/Harness.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/Incident/Projection.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/IncidentReaction/ProcessHarness.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/BehaviorContract.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/Harness.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/Projection.hs+uncompiled-generated keiro-dsl/test/conformance-process-reactions/Generated/ProcessReactions/ReplayAudit.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/BehaviorSourceMap.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/Incident/BehaviorContract.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/Incident/Harness.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/Incident/Projection.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/BehaviorContract.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/Harness.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/Projection.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/IncidentTimers/ProcessHarness.hs+uncompiled-generated keiro-dsl/test/conformance-process-timers/Generated/ProcessTimers/ReplayAudit.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/BehaviorSourceMap.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/BehaviorContract.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/Harness.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/Projection.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/Incident/BehaviorContract.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/Incident/Harness.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/Incident/Projection.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/IncidentEscalation/ProcessHarness.hs+uncompiled-generated keiro-dsl/test/conformance-process-state-authority/Generated/IncidentResponse/ReplayAudit.hs uncompiled-generated keiro-dsl/test/conformance-process/Generated/HospitalCapacity/Hospital/BehaviorContract.hs uncompiled-generated keiro-dsl/test/conformance-process/Generated/HospitalCapacity/Hospital/Codec.hs uncompiled-generated keiro-dsl/test/conformance-process/Generated/HospitalCapacity/Hospital/Domain.hs
test/conformance-declarative-router/Generated/TransferRouting/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context transfer-routing behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context transfer-routing behavior source map; do not edit. module Generated.TransferRouting.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-declarative-router/Generated/TransferRouting/Hospital/BehaviorContract.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Codec (     hospitalCodec,     parseHospitalEvent,
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Domain where  import Data.Proxy (Proxy (..))
test/conformance-declarative-router/Generated/TransferRouting/Hospital/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.EventStream   ( hospitalCategory   , hospitalCommandCategory
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Harness.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Harness (harnessAssertions) where  import Generated.TransferRouting.Hospital.Domain
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Transducer   ( hospitalTransducer   , hospitalFoldFingerprint
test/conformance-declarative-router/Generated/TransferRouting/HospitalLoad/QueryContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel hospital_load; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel hospital_load; do not edit. module Generated.TransferRouting.HospitalLoad.QueryContract   ( HospitalLoadQueryInput   , HospitalLoadQueryResult
test/conformance-declarative-router/Generated/TransferRouting/HospitalLoad/ReadModel.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel hospital_load; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel hospital_load; do not edit. module Generated.TransferRouting.HospitalLoad.ReadModel   ( hospitalLoadReadModel   , hospitalLoadQualifiedTable
test/conformance-declarative-router/Generated/TransferRouting/HospitalLoad/ReadModelHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel hospital_load; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel hospital_load; do not edit. module Generated.TransferRouting.HospitalLoad.ReadModelHarness (readModelFacts, readModelFactResults, runReadModelFacts, catalogFactsAgainst) where  import Generated.TransferRouting.HospitalLoad.ReadModel (hospitalLoadReadModel)
test/conformance-declarative-router/Generated/TransferRouting/HospitalLoad/ReadModelTable.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel hospital_load; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel hospital_load; do not edit. module Generated.TransferRouting.HospitalLoad.ReadModelTable (hospitalLoadQualifiedTable) where  import Data.Text (Text)
test/conformance-declarative-router/Generated/TransferRouting/HospitalTransferRouter/Router.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from router HospitalTransferRouter; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from router HospitalTransferRouter; do not edit. module Generated.TransferRouting.HospitalTransferRouter.Router   ( hospitalTransferRouterName   , hospitalTransferRouterWorkerOptions
test/conformance-declarative-router/Generated/TransferRouting/HospitalTransferRouter/RouterHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from router HospitalTransferRouter; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from router HospitalTransferRouter; do not edit. module Generated.TransferRouting.HospitalTransferRouter.RouterHarness (routerHarnessValues) where  routerHarnessValues :: [(String, String)]
test/conformance-declarative-router/Generated/TransferRouting/ProjectionCatalog.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from projection-catalog transfer-routing; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from projection-catalog transfer-routing; do not edit. {-# LANGUAGE OverloadedStrings #-} module Generated.TransferRouting.ProjectionCatalog   ( projectionCatalog
test/conformance-declarative-router/Generated/TransferRouting/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context transfer-routing replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context transfer-routing replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-declarative-router/Generated/TransferRouting/Structural/Shape/HospitalLoadRow.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural HospitalLoadRow; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural HospitalLoadRow; do not edit. module Generated.TransferRouting.Structural.Shape.HospitalLoadRow (HospitalLoadRowShape (..)) where  import Data.Text (Text)
test/conformance-declarative-router/Generated/TransferRouting/Structural/Shape/TransferRouteInput.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural TransferRouteInput; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural TransferRouteInput; do not edit. module Generated.TransferRouting.Structural.Shape.TransferRouteInput (TransferRouteInputShape (..)) where  import Data.Text (Text)
test/conformance-declarative-router/Generated/TransferRouting/StructuralConformance.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context transfer-routing structural conformance; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context transfer-routing structural conformance; do not edit. module Generated.TransferRouting.StructuralConformance   ( structuralConformanceAssertions   ) where@@ -11,8 +11,6 @@ import Keiki.Shape (CanonicalTypeName (..)) import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape) import Generated.TransferRouting.StructuralProjections qualified as StructuralProjections-import Generated.TransferRouting.Structural.Shape.HospitalLoadRow (HospitalLoadRowShape(availableBeds, hospitalId, region))-import Generated.TransferRouting.Structural.Shape.TransferRouteInput (TransferRouteInputShape(region, transferNeedId)) import Conformance.DeclarativeRouter.Bindings qualified as Bindings import Conformance.DeclarativeRouter.Domain (HospitalLoadRow, TransferRouteInput) @@ -66,9 +64,9 @@  structuralProjectionAssertions :: [(String, Bool)] structuralProjectionAssertions =-  [ ("projection witness agreement: conformance.declarative-router.HospitalLoadRow.v1/available_beds", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.hospitalLoadRowAvailableBedsWitness (\referenceOwner -> (bindingToShape Bindings.hospitalLoadRowBinding referenceOwner).availableBeds) owner) (NonEmpty.toList (fixtureCases Bindings.hospitalLoadRowCases)))-  , ("projection witness agreement: conformance.declarative-router.HospitalLoadRow.v1/hospital_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.hospitalLoadRowHospitalIdWitness (\referenceOwner -> (bindingToShape Bindings.hospitalLoadRowBinding referenceOwner).hospitalId) owner) (NonEmpty.toList (fixtureCases Bindings.hospitalLoadRowCases)))-  , ("projection witness agreement: conformance.declarative-router.HospitalLoadRow.v1/region", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.hospitalLoadRowRegionWitness (\referenceOwner -> (bindingToShape Bindings.hospitalLoadRowBinding referenceOwner).region) owner) (NonEmpty.toList (fixtureCases Bindings.hospitalLoadRowCases)))-  , ("projection witness agreement: conformance.declarative-router.TransferRouteInput.v1/region", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.transferRouteInputRegionWitness (\referenceOwner -> (bindingToShape Bindings.transferRouteInputBinding referenceOwner).region) owner) (NonEmpty.toList (fixtureCases Bindings.transferRouteInputCases)))-  , ("projection witness agreement: conformance.declarative-router.TransferRouteInput.v1/transfer_need_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.transferRouteInputTransferNeedIdWitness (\referenceOwner -> (bindingToShape Bindings.transferRouteInputBinding referenceOwner).transferNeedId) owner) (NonEmpty.toList (fixtureCases Bindings.transferRouteInputCases)))+  [ ("projection witness agreement: conformance.declarative-router.HospitalLoadRow.v1/available_beds", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.hospitalLoadRowAvailableBedsWitness (\referenceOwner -> StructuralProjections.hospitalLoadRowAvailableBedsGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.hospitalLoadRowCases)))+  , ("projection witness agreement: conformance.declarative-router.HospitalLoadRow.v1/hospital_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.hospitalLoadRowHospitalIdWitness (\referenceOwner -> StructuralProjections.hospitalLoadRowHospitalIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.hospitalLoadRowCases)))+  , ("projection witness agreement: conformance.declarative-router.HospitalLoadRow.v1/region", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.hospitalLoadRowRegionWitness (\referenceOwner -> StructuralProjections.hospitalLoadRowRegionGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.hospitalLoadRowCases)))+  , ("projection witness agreement: conformance.declarative-router.TransferRouteInput.v1/region", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.transferRouteInputRegionWitness (\referenceOwner -> StructuralProjections.transferRouteInputRegionGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.transferRouteInputCases)))+  , ("projection witness agreement: conformance.declarative-router.TransferRouteInput.v1/transfer_need_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.transferRouteInputTransferNeedIdWitness (\referenceOwner -> StructuralProjections.transferRouteInputTransferNeedIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.transferRouteInputCases)))   ]
test/conformance-declarative-router/Generated/TransferRouting/StructuralProjections.hs view
@@ -1,13 +1,19 @@ {-# LANGUAGE TypeFamilies #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context transfer-routing mapped structural facade; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context transfer-routing mapped structural facade; do not edit. -- Equality witnesses are emitted for Text, Int, Bool, Natural, and UTCTime.+-- Nominal ID and enum leaves carry exact canonical-text domains. -- Int, Natural, and UTCTime belong to Keiki's ordered subset. module Generated.TransferRouting.StructuralProjections   ( hospitalLoadRowAvailableBedsWitness+  , hospitalLoadRowAvailableBedsGet   , hospitalLoadRowHospitalIdWitness+  , hospitalLoadRowHospitalIdGet   , hospitalLoadRowRegionWitness+  , hospitalLoadRowRegionGet   , transferRouteInputRegionWitness+  , transferRouteInputRegionGet   , transferRouteInputTransferNeedIdWitness+  , transferRouteInputTransferNeedIdGet   ) where  import Data.Text (Text)@@ -20,60 +26,75 @@  data HospitalLoadRowAvailableBedsProjection +hospitalLoadRowAvailableBedsGet :: HospitalLoadRow -> Int+hospitalLoadRowAvailableBedsGet owner = (bindingToShape Bindings.hospitalLoadRowBinding owner).availableBeds+ instance FieldProjection HospitalLoadRowAvailableBedsProjection where   type FieldName HospitalLoadRowAvailableBedsProjection = "/available_beds"   type FieldOwner HospitalLoadRowAvailableBedsProjection = HospitalLoadRow   type FieldResult HospitalLoadRowAvailableBedsProjection = Int   fieldShapeId _ = "conformance.declarative-router.HospitalLoadRow.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.hospitalLoadRowBinding owner).availableBeds+  projectFieldValue _ = hospitalLoadRowAvailableBedsGet  hospitalLoadRowAvailableBedsWitness :: FieldWitness HospitalLoadRowAvailableBedsProjection hospitalLoadRowAvailableBedsWitness = fieldWitness @HospitalLoadRowAvailableBedsProjection  data HospitalLoadRowHospitalIdProjection +hospitalLoadRowHospitalIdGet :: HospitalLoadRow -> Text+hospitalLoadRowHospitalIdGet owner = (bindingToShape Bindings.hospitalLoadRowBinding owner).hospitalId+ instance FieldProjection HospitalLoadRowHospitalIdProjection where   type FieldName HospitalLoadRowHospitalIdProjection = "/hospital_id"   type FieldOwner HospitalLoadRowHospitalIdProjection = HospitalLoadRow   type FieldResult HospitalLoadRowHospitalIdProjection = Text   fieldShapeId _ = "conformance.declarative-router.HospitalLoadRow.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.hospitalLoadRowBinding owner).hospitalId+  projectFieldValue _ = hospitalLoadRowHospitalIdGet  hospitalLoadRowHospitalIdWitness :: FieldWitness HospitalLoadRowHospitalIdProjection hospitalLoadRowHospitalIdWitness = fieldWitness @HospitalLoadRowHospitalIdProjection  data HospitalLoadRowRegionProjection +hospitalLoadRowRegionGet :: HospitalLoadRow -> Text+hospitalLoadRowRegionGet owner = (bindingToShape Bindings.hospitalLoadRowBinding owner).region+ instance FieldProjection HospitalLoadRowRegionProjection where   type FieldName HospitalLoadRowRegionProjection = "/region"   type FieldOwner HospitalLoadRowRegionProjection = HospitalLoadRow   type FieldResult HospitalLoadRowRegionProjection = Text   fieldShapeId _ = "conformance.declarative-router.HospitalLoadRow.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.hospitalLoadRowBinding owner).region+  projectFieldValue _ = hospitalLoadRowRegionGet  hospitalLoadRowRegionWitness :: FieldWitness HospitalLoadRowRegionProjection hospitalLoadRowRegionWitness = fieldWitness @HospitalLoadRowRegionProjection  data TransferRouteInputRegionProjection +transferRouteInputRegionGet :: TransferRouteInput -> Text+transferRouteInputRegionGet owner = (bindingToShape Bindings.transferRouteInputBinding owner).region+ instance FieldProjection TransferRouteInputRegionProjection where   type FieldName TransferRouteInputRegionProjection = "/region"   type FieldOwner TransferRouteInputRegionProjection = TransferRouteInput   type FieldResult TransferRouteInputRegionProjection = Text   fieldShapeId _ = "conformance.declarative-router.TransferRouteInput.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.transferRouteInputBinding owner).region+  projectFieldValue _ = transferRouteInputRegionGet  transferRouteInputRegionWitness :: FieldWitness TransferRouteInputRegionProjection transferRouteInputRegionWitness = fieldWitness @TransferRouteInputRegionProjection  data TransferRouteInputTransferNeedIdProjection +transferRouteInputTransferNeedIdGet :: TransferRouteInput -> Text+transferRouteInputTransferNeedIdGet owner = (bindingToShape Bindings.transferRouteInputBinding owner).transferNeedId+ instance FieldProjection TransferRouteInputTransferNeedIdProjection where   type FieldName TransferRouteInputTransferNeedIdProjection = "/transfer_need_id"   type FieldOwner TransferRouteInputTransferNeedIdProjection = TransferRouteInput   type FieldResult TransferRouteInputTransferNeedIdProjection = Text   fieldShapeId _ = "conformance.declarative-router.TransferRouteInput.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.transferRouteInputBinding owner).transferNeedId+  projectFieldValue _ = transferRouteInputTransferNeedIdGet  transferRouteInputTransferNeedIdWitness :: FieldWitness TransferRouteInputTransferNeedIdProjection transferRouteInputTransferNeedIdWitness = fieldWitness @TransferRouteInputTransferNeedIdProjection
test/conformance-dispatch-full/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModel.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel accepted_transfer_needs; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel accepted_transfer_needs; do not edit. module Generated.HospitalCapacity.AcceptedTransferNeeds.ReadModel   ( acceptedTransferNeedsReadModel   , acceptedTransferNeedsQualifiedTable
test/conformance-dispatch-full/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel accepted_transfer_needs; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel accepted_transfer_needs; do not edit. module Generated.HospitalCapacity.AcceptedTransferNeeds.ReadModelHarness (readModelFacts, readModelFactResults, runReadModelFacts) where  import Generated.HospitalCapacity.AcceptedTransferNeeds.ReadModel (acceptedTransferNeedsReadModel, acceptedTransferNeedsAsyncProjection)
test/conformance-dispatch-full/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelTable.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel accepted_transfer_needs; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel accepted_transfer_needs; do not edit. module Generated.HospitalCapacity.AcceptedTransferNeeds.ReadModelTable (acceptedTransferNeedsQualifiedTable) where  import Data.Text (Text)
test/conformance-dispatch-full/Generated/HospitalCapacity/ReservationWork/Queue.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from workqueue reservation_work; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from workqueue reservation_work; do not edit. module Generated.HospitalCapacity.ReservationWork.Queue   ( ReservationWorkItem (..)   , encodeReservationWorkItem
test/conformance-dispatch-full/Generated/HospitalCapacity/ReservationWork/QueueCodec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from workqueue reservation_work; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from workqueue reservation_work; do not edit. -- | Versioned job payload envelope: @{\"v\",\"t\",\"data\"}@. -- -- Deploy workers before producers when raising its schema version. Do not
test/conformance-dispatch-full/Generated/HospitalCapacity/ReservationWork/QueuePolicy.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from workqueue reservation_work; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from workqueue reservation_work; do not edit. module Generated.HospitalCapacity.ReservationWork.QueuePolicy   ( ReservationWorkOutcome (..)   , retryPolicy, jobOutcomeFor@@ -10,7 +10,7 @@ jobOrdering :: JobOrdering jobOrdering = FifoThroughput --- Deployment owns visibility timeout, batch size, and polling; the spec owns ordering.+-- Deployment owns a positive batch size, visibility timeout, and polling; the spec owns ordering. Legacy FIFO modes reject batch sizes greater than one. jobTuningFor :: JobTuning -> JobTuning jobTuningFor = withOrdering jobOrdering
test/conformance-dispatch-full/Generated/HospitalCapacity/TransferDecisions/ReadModel.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel transfer_decisions; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel transfer_decisions; do not edit. module Generated.HospitalCapacity.TransferDecisions.ReadModel   ( transferDecisionsReadModel   , transferDecisionsQualifiedTable
test/conformance-dispatch-full/Generated/HospitalCapacity/TransferDecisions/ReadModelHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel transfer_decisions; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel transfer_decisions; do not edit. module Generated.HospitalCapacity.TransferDecisions.ReadModelHarness (readModelFacts, readModelFactResults, runReadModelFacts) where  import Generated.HospitalCapacity.TransferDecisions.ReadModel (transferDecisionsReadModel, transferDecisionsAsyncProjection)
test/conformance-dispatch-full/Generated/HospitalCapacity/TransferDecisions/ReadModelTable.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel transfer_decisions; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel transfer_decisions; do not edit. module Generated.HospitalCapacity.TransferDecisions.ReadModelTable (transferDecisionsQualifiedTable) where  import Data.Text (Text)
test/conformance-dispatch-full/HospitalCapacity/ReservationWork/WorkqueueJob.hs view
@@ -13,7 +13,7 @@     ReservationWorkItem,  ) import Generated.HospitalCapacity.ReservationWork.QueueCodec (reservationWorkJobCodec)-import Generated.HospitalCapacity.ReservationWork.QueuePolicy (retryPolicy)+import Generated.HospitalCapacity.ReservationWork.QueuePolicy qualified as QueuePolicy import Keiro.PGMQ.Job (Job (..), JobOutcome (..)) import Keiro.PGMQ.Runtime (queueRef) @@ -24,7 +24,8 @@         { jobName = "reservation-work"         , jobQueue = queueRef "hospital_capacity.reservation_work"         , jobCodec = reservationWorkJobCodec-        , jobPolicy = retryPolicy+        , jobOrdering = QueuePolicy.jobOrdering+        , jobPolicy = QueuePolicy.retryPolicy         }  {- | The worker hole, filled: process one work item, decide an outcome. (A real
test/conformance-domain-outcomes/Generated/DomainOutcomes/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context domain-outcomes behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context domain-outcomes behavior source map; do not edit. module Generated.DomainOutcomes.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-domain-outcomes/Generated/DomainOutcomes/Nominals.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context domain-outcomes generated nominal declarations; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context domain-outcomes generated nominal declarations; do not edit. module Generated.DomainOutcomes.Nominals where  import Data.Aeson (FromJSON, ToJSON)
test/conformance-domain-outcomes/Generated/DomainOutcomes/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context domain-outcomes replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context domain-outcomes replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/BehaviorContract.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit. module Generated.DomainOutcomes.Reservation.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit. module Generated.DomainOutcomes.Reservation.Codec (     reservationCodec,     parseReservationEvent,
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit. module Generated.DomainOutcomes.Reservation.Domain where  import Data.Proxy (Proxy (..))
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit. module Generated.DomainOutcomes.Reservation.EventStream   ( reservationCategory   , reservationCommandCategory
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Harness.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit. module Generated.DomainOutcomes.Reservation.Harness (harnessAssertions) where  import Generated.DomainOutcomes.Reservation.Domain
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit. module Generated.DomainOutcomes.Reservation.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit. module Generated.DomainOutcomes.Reservation.Transducer   ( reservationTransducer   , reservationFoldFingerprint
test/conformance-id-domain-migration/Generated/IdDomainMigration/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from context id-domain-migration behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from context id-domain-migration behavior source map; do not edit. module Generated.IdDomainMigration.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-id-domain-migration/Generated/IdDomainMigration/Nominals.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from context id-domain-migration generated nominal declarations; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from context id-domain-migration generated nominal declarations; do not edit. module Generated.IdDomainMigration.Nominals   ( OrderId   , parseOrderId
test/conformance-id-domain-migration/Generated/IdDomainMigration/Nominals/Internal.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from context id-domain-migration generated nominal ID internals; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from context id-domain-migration generated nominal ID internals; do not edit. module Generated.IdDomainMigration.Nominals.Internal   ( OrderId   , parseOrderId
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/BehaviorContract.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit. module Generated.IdDomainMigration.OrderBook.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit. module Generated.IdDomainMigration.OrderBook.Codec (     orderBookCodec,     parseOrderBookEvent,
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Domain.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit. module Generated.IdDomainMigration.OrderBook.Domain where  import Data.Aeson (FromJSON, ToJSON)
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit. module Generated.IdDomainMigration.OrderBook.EventStream   ( orderBookCategory   , orderBookCommandCategory
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Harness.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit. module Generated.IdDomainMigration.OrderBook.Harness (harnessAssertions) where  import Generated.IdDomainMigration.OrderBook.Domain
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit. module Generated.IdDomainMigration.OrderBook.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit. module Generated.IdDomainMigration.OrderBook.Transducer   ( orderBookTransducer   , orderBookFoldFingerprint
test/conformance-id-domain-migration/Generated/IdDomainMigration/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 3) from context id-domain-migration replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 3) from context id-domain-migration replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-import-planning/Generated/ImportPlanningCollisions/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context import-planning-collisions behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context import-planning-collisions behavior source map; do not edit. module Generated.ImportPlanningCollisions.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/BehaviorContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit. module Generated.ImportPlanningCollisions.CollisionLedger.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit. module Generated.ImportPlanningCollisions.CollisionLedger.Codec (     collisionLedgerCodec,     parseCollisionLedgerEvent,
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit. module Generated.ImportPlanningCollisions.CollisionLedger.Domain where  import GHC.Generics (Generic)
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit. module Generated.ImportPlanningCollisions.CollisionLedger.EventStream   ( collisionLedgerCategory   , collisionLedgerCommandCategory
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Harness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit. module Generated.ImportPlanningCollisions.CollisionLedger.Harness (harnessAssertions) where  import Generated.ImportPlanningCollisions.CollisionLedger.Domain
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit. module Generated.ImportPlanningCollisions.CollisionLedger.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit. module Generated.ImportPlanningCollisions.CollisionLedger.Transducer   ( collisionLedgerTransducer   , collisionLedgerFoldFingerprint
test/conformance-import-planning/Generated/ImportPlanningCollisions/NominalProjections.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TypeFamilies #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context import-planning-collisions nominal scalar projection facade; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context import-planning-collisions nominal scalar projection facade; do not edit. module Generated.ImportPlanningCollisions.NominalProjections where  import Data.Text (Text)
test/conformance-import-planning/Generated/ImportPlanningCollisions/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context import-planning-collisions replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context import-planning-collisions replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-import-planning/Generated/ImportPlanningCollisions/Structural/Shape/Details.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from mapped structural Details; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from mapped structural Details; do not edit. module Generated.ImportPlanningCollisions.Structural.Shape.Details (DetailsShape (..)) where  import Data.Text (Text)
test/conformance-import-planning/Generated/ImportPlanningCollisions/StructuralConformance.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context import-planning-collisions structural conformance; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context import-planning-collisions structural conformance; do not edit. module Generated.ImportPlanningCollisions.StructuralConformance   ( structuralConformanceAssertions   ) where@@ -11,7 +11,6 @@ import Keiki.Shape (CanonicalTypeName (..)) import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape) import Generated.ImportPlanningCollisions.StructuralProjections qualified as StructuralProjections-import Generated.ImportPlanningCollisions.Structural.Shape.Details (DetailsShape(label)) import ImportPlanning.Bindings qualified as Bindings import ImportPlanning.Consumer.Shared.Types (Details) @@ -47,5 +46,5 @@  structuralProjectionAssertions :: [(String, Bool)] structuralProjectionAssertions =-  [ ("projection witness agreement: import-planning.Details.v1/label", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.detailsLabelWitness (\referenceOwner -> (bindingToShape Bindings.detailsBinding referenceOwner).label) owner) (NonEmpty.toList (fixtureCases Bindings.detailsFixtures)))+  [ ("projection witness agreement: import-planning.Details.v1/label", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.detailsLabelWitness (\referenceOwner -> StructuralProjections.detailsLabelGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.detailsFixtures)))   ]
test/conformance-import-planning/Generated/ImportPlanningCollisions/StructuralProjections.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE TypeFamilies #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context import-planning-collisions mapped structural facade; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context import-planning-collisions mapped structural facade; do not edit. -- Equality witnesses are emitted for Text, Int, Bool, Natural, and UTCTime.+-- Nominal ID and enum leaves carry exact canonical-text domains. -- Int, Natural, and UTCTime belong to Keiki's ordered subset. module Generated.ImportPlanningCollisions.StructuralProjections   ( detailsLabelWitness+  , detailsLabelGet   ) where  import Data.Text (Text)@@ -15,12 +17,15 @@  data DetailsLabelProjection +detailsLabelGet :: Details -> Text+detailsLabelGet owner = (bindingToShape Bindings.detailsBinding owner).label+ instance FieldProjection DetailsLabelProjection where   type FieldName DetailsLabelProjection = "/label"   type FieldOwner DetailsLabelProjection = Details   type FieldResult DetailsLabelProjection = Text   fieldShapeId _ = "import-planning.Details.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.detailsBinding owner).label+  projectFieldValue _ = detailsLabelGet  detailsLabelWitness :: FieldWitness DetailsLabelProjection detailsLabelWitness = fieldWitness @DetailsLabelProjection
+ test/conformance-intake-delegated/Generated/HospitalCapacity/Emergency/Contract.hs view
@@ -0,0 +1,64 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from contract emergency; do not edit.+module Generated.HospitalCapacity.Emergency.Contract+  ( EmergencyPayload (..)+  , IncidentTransferNeedDeclaredData (..)+  , incidentEventsTopic+  , messageTypeOf+  , encodeEmergencyPayload+  , parseEmergencyPayload+  ) where++import Data.Aeson (Value, object, withObject, withText, (.:), (.=))+import Data.Aeson.Types (Parser, explicitParseField, parseEither)+import Data.KindID (KindID)+import qualified Data.KindID as KindID+import Data.Text (Text)+import qualified Data.Text as T+import Keiro.Codec.IdDomain (parseKindIdV7Value)++-- topic constants+incidentEventsTopic :: Text+incidentEventsTopic = "emergency.incident.events"++-- the closed payload set (discriminated by "messageType")+data IncidentTransferNeedDeclaredData = IncidentTransferNeedDeclaredData {incidentId :: !(KindID "inc"), region :: !Text}+  deriving stock (Eq, Show)++data EmergencyPayload+  = IncidentTransferNeedDeclared !IncidentTransferNeedDeclaredData+  deriving stock (Eq, Show)++messageTypeOf :: EmergencyPayload -> Text+messageTypeOf = \case+  IncidentTransferNeedDeclared {} -> "IncidentTransferNeedDeclared"++encodeEmergencyPayload :: EmergencyPayload -> Value+encodeEmergencyPayload = \case+  IncidentTransferNeedDeclared payload ->+    object+      [ "messageType" .= ("IncidentTransferNeedDeclared" :: Text),+        "incidentId" .= KindID.toText payload.incidentId,+        "region" .= payload.region+      ]++parseEmergencyPayload :: Value -> Either Text EmergencyPayload+parseEmergencyPayload = mapLeftText . parseEither (withObject "EmergencyPayload" go)+  where+    go o = do+      kind <- explicitParseField (withText "messageType" validateMessageType) o "messageType"+      case kind of+        "IncidentTransferNeedDeclared" ->+          IncidentTransferNeedDeclared+            <$> ( IncidentTransferNeedDeclaredData+                    <$> explicitParseField (parseKindIdV7Value @"inc") o "incidentId"+                    <*> o .: "region"+                )+        _ -> 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` ["IncidentTransferNeedDeclared"] = pure kind+  | otherwise = fail ("unknown message type " <> show kind <> "; expected one of: IncidentTransferNeedDeclared")
+ test/conformance-intake-delegated/Generated/HospitalCapacity/IncidentInbox/Inbox.hs view
@@ -0,0 +1,93 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from intake incidentInbox; do not edit.+module Generated.HospitalCapacity.IncidentInbox.Inbox+  ( InboxFailure (..)+  , IncidentInboxOutcome (..)+  , IncidentInboxDisposition (..)+  , inboxDedupePolicy+  , inboxIdempotence+  , runInboxIntake+  , inboxDispositionFor+  , inboxDisposition+  ) where++import Data.Text (Text)+import Effectful (Eff, IOE, (:>))+import Keiro.Inbox (runInboxDelegated)+import Keiro.Inbox.Types (DelegatedOutcome, InboxDedupePolicy (..), InboxError, InboxIdempotence (..), InboxResult (..), KafkaDeliveryRef, RetryDelay (..))+import Keiro.Integration.Event (IntegrationEvent)+import Keiro.Telemetry (KeiroMetrics)++-- The dedupe policy (hole-kind 4), lowered to the live InboxDedupePolicy.+inboxDedupePolicy :: InboxDedupePolicy+inboxDedupePolicy = PreferIntegrationMessageId++-- | The downstream state machine owns the durable dedupe receipt.+inboxIdempotence :: InboxIdempotence+inboxIdempotence = IdempotenceDelegated++-- | Run this intake without reading or writing the Keiro inbox table.+runInboxIntake ::+  IOE :> es =>+  Maybe KeiroMetrics ->+  IntegrationEvent ->+  Maybe KafkaDeliveryRef ->+  (Text -> IntegrationEvent -> Eff es (DelegatedOutcome a)) ->+  Eff es (Either InboxError (InboxResult a))+runInboxIntake metrics event delivery =+  runInboxDelegated metrics inboxDedupePolicy event delivery++-- Runtime failure detail retained when the inbox wrapper reports a failed handler attempt.+data InboxFailure = InboxFailure+  { reason :: !Text+  , attempt :: !(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 IncidentInboxOutcome+  = IncidentInboxProcessed+  | IncidentInboxDuplicate+  | IncidentInboxInProgress+  | IncidentInboxPreviouslyFailed+  | IncidentInboxDecodeFailed+  | IncidentInboxDedupeFailed+  | IncidentInboxStoreFailed+  deriving stock (Eq, Show)++-- The service's declared acknowledgement decision, including its details.+data IncidentInboxDisposition+  = InboxAccept+  | InboxRetryAfter !RetryDelay !(Maybe InboxFailure)+  | InboxDeadLetter !(Maybe Text) !(Maybe InboxFailure)+  deriving stock (Eq, Show)++-- The complete disposition table (hole-kind 2).+inboxDispositionFor :: IncidentInboxOutcome -> IncidentInboxDisposition+inboxDispositionFor outcome = case outcome of+  IncidentInboxProcessed -> InboxAccept+  IncidentInboxDuplicate -> InboxAccept+  IncidentInboxInProgress -> InboxRetryAfter (RetryDelay 5) Nothing+  IncidentInboxPreviouslyFailed -> InboxDeadLetter (Just "previous inbox failure") Nothing+  IncidentInboxDecodeFailed -> InboxDeadLetter Nothing Nothing+  IncidentInboxDedupeFailed -> InboxDeadLetter Nothing Nothing+  IncidentInboxStoreFailed -> InboxRetryAfter (RetryDelay 5) Nothing++-- Lower the LIVE Keiro.Inbox.Types.InboxResult without an open fallback.+inboxDisposition :: InboxResult a -> IncidentInboxDisposition+inboxDisposition r = case r of+  InboxProcessed _ -> inboxDispositionFor IncidentInboxProcessed+  InboxDuplicate -> inboxDispositionFor IncidentInboxDuplicate+  InboxInProgress -> inboxDispositionFor IncidentInboxInProgress+  InboxPreviouslyFailed failureReason ->+    maybe (inboxDispositionFor IncidentInboxPreviouslyFailed)+      (\reason -> attachFailure (InboxFailure reason Nothing) (inboxDispositionFor IncidentInboxPreviouslyFailed))+      failureReason+  InboxHandlerFailed reason attempts ->+    attachFailure (InboxFailure reason (Just attempts)) (inboxDispositionFor IncidentInboxStoreFailed)++attachFailure :: InboxFailure -> IncidentInboxDisposition -> IncidentInboxDisposition+attachFailure failure disposition = case disposition of+  InboxRetryAfter delay _ -> InboxRetryAfter delay (Just failure)+  InboxDeadLetter reason _ -> InboxDeadLetter reason (Just failure)+  InboxAccept -> InboxAccept
+ test/conformance-intake-delegated/HospitalCapacity/IncidentInbox/DelegatedIntegration.hs view
@@ -0,0 +1,20 @@+-- HAND-FILLED delegated integration: the generated runner fixes the intake+-- policy while the service supplies the downstream durable outcome handler.+module HospitalCapacity.IncidentInbox.DelegatedIntegration+  ( runIncidentInbox,+  )+where++import Effectful (Eff, IOE, (:>))+import Data.Text (Text)+import Generated.HospitalCapacity.IncidentInbox.Inbox (runInboxIntake)+import Keiro.Inbox.Types (DelegatedOutcome, InboxError, InboxResult, KafkaDeliveryRef)+import Keiro.Integration.Event (IntegrationEvent)++runIncidentInbox ::+  IOE :> es =>+  IntegrationEvent ->+  Maybe KafkaDeliveryRef ->+  (Text -> IntegrationEvent -> Eff es (DelegatedOutcome a)) ->+  Eff es (Either InboxError (InboxResult a))+runIncidentInbox = runInboxIntake Nothing
+ test/conformance-intake-delegated/Main.hs view
@@ -0,0 +1,43 @@+module Main (main) where++import Control.Monad (unless)+import Data.Text (Text)+import Data.Time (UTCTime (..), fromGregorian)+import Effectful (runEff)+import Generated.HospitalCapacity.IncidentInbox.Inbox (inboxIdempotence)+import HospitalCapacity.IncidentInbox.DelegatedIntegration (runIncidentInbox)+import Keiro.Inbox.Types (DelegatedOutcome (..), InboxIdempotence (..), InboxResult (..))+import Keiro.Integration.Event (IntegrationContentType (..), IntegrationEvent (..))+import System.Exit (exitFailure)++main :: IO ()+main = do+  fresh <- runEff $ runIncidentInbox event Nothing (\key _ -> pure (DelegatedFresh key))+  duplicate <- runEff $ runIncidentInbox event Nothing (\_ _ -> pure (DelegatedDuplicate :: DelegatedOutcome Text))+  let modeOk = inboxIdempotence == IdempotenceDelegated+      freshOk = fresh == Right (InboxProcessed "delegated-message")+      duplicateOk = duplicate == Right InboxDuplicate+  putStrLn ("delegated idempotence mode: " <> show modeOk)+  putStrLn ("generated runner returns fresh: " <> show freshOk)+  putStrLn ("generated runner returns duplicate: " <> show duplicateOk)+  unless (modeOk && freshOk && duplicateOk) exitFailure+  where+    event =+      IntegrationEvent+        { messageId = "delegated-message",+          source = "hospital-capacity",+          destination = "billing",+          key = Nothing,+          eventType = "IncidentTransferNeedDeclared",+          schemaVersion = 1,+          contentType = ApplicationJson,+          schemaReference = Nothing,+          sourceEventId = Nothing,+          sourceGlobalPosition = Nothing,+          payloadBytes = "{}",+          occurredAt = UTCTime (fromGregorian 2026 9 15) 0,+          causationId = Nothing,+          correlationId = Nothing,+          traceContext = Nothing,+          attributes = Nothing+        }
+ test/conformance-intake-delegated/keiro-dsl-cabal-fragment.context.hospital-capacity.txt view
@@ -0,0 +1,24 @@+-- keiro-dsl build manifest for keiro-dsl/test/fixtures/intake-delegated.keiro+-- Paste the complete fragment below into the consuming Cabal stanza.+-- The generated layer is overwritten on every scaffold; hole modules are+-- create-if-absent (filled by hand).++default-language: GHC2024+default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings++other-modules:+    Generated.HospitalCapacity.Emergency.Contract+    Generated.HospitalCapacity.IncidentInbox.Inbox++build-depends:+    , aeson+    , base+    , effectful-core+    , keiro+    , keiro-core+    , mmzk-typeid+    , text
+ test/conformance-intake-delegated/keiro-dsl-ledger.context.hospital-capacity.txt view
@@ -0,0 +1,13 @@+keiro-dsl scaffold record v1+spec: keiro-dsl/test/fixtures/intake-delegated.keiro+module-root: (none)+layout: prefixed+source-language {"declaredLanguageVersion":6,"effectiveLanguageVersion":6,"sourceForm":"declared"}+semantic-contract {"languageSupport":"candidate","languageVersion":6,"runtimeSemantics":"keiro-dsl/runtime-semantics/5"}+naming-edition idiomatic-v2+module-role {"family":"Contract","kind":"generated","ownerKind":"contract","ownerName":"contract emergency (line 4)","path":"Generated/HospitalCapacity/Emergency/Contract.hs"}+module-role {"family":"Inbox","kind":"generated","ownerKind":"intake","ownerName":"intake incidentInbox (line 14)","path":"Generated/HospitalCapacity/IncidentInbox/Inbox.hs"}+generated Generated/HospitalCapacity/Emergency/Contract.hs+generated Generated/HospitalCapacity/IncidentInbox/Inbox.hs+id-domain id-domain|name=contract:emergency.IncidentTransferNeedDeclared.incidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text+semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
test/conformance-intake-full/Generated/HospitalCapacity/Emergency/Contract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from contract emergency; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from contract emergency; do not edit. module Generated.HospitalCapacity.Emergency.Contract   ( EmergencyPayload (..)   , IncidentTransferNeedDeclaredData (..)
test/conformance-intake-full/Generated/HospitalCapacity/IncidentInbox/Inbox.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from intake incidentInbox; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from intake incidentInbox; do not edit. module Generated.HospitalCapacity.IncidentInbox.Inbox   ( InboxFailure (..)   , IncidentInboxOutcome (..)
test/conformance-intake-runtime/Generated/HospitalCapacity/Emergency/Contract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from contract emergency; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from contract emergency; do not edit. module Generated.HospitalCapacity.Emergency.Contract   ( EmergencyPayload (..)   , IncidentTransferNeedDeclaredData (..)
test/conformance-intake-runtime/Generated/HospitalCapacity/IncidentInbox/Inbox.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from intake incidentInbox; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from intake incidentInbox; do not edit. module Generated.HospitalCapacity.IncidentInbox.Inbox   ( InboxFailure (..)   , IncidentInboxOutcome (..)
test/conformance-mapped-queue/Generated/MappedQueue/MappedJobs/Queue.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from workqueue mapped_jobs; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from workqueue mapped_jobs; do not edit. module Generated.MappedQueue.MappedJobs.Queue   ( MappedJob (..)   , encodeMappedJob@@ -48,13 +48,13 @@ encodeJobMetadataShape :: ShapeJobMetadata.JobMetadataShape -> Value encodeJobMetadataShape shape =   object-      [ "note" .= maybe Null (\item -> toJSON (item)) (shape.note)+      [ "note" .= maybe Null (\item0 -> toJSON (item0)) (shape.note)       ]  parseJobMetadataShape :: Value -> Parser ShapeJobMetadata.JobMetadataShape parseJobMetadataShape = withObject "JobMetadataShape" $ \objectValue -> do   ShapeJobMetadata.JobMetadata-    <$> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) objectValue "note"+    <$> explicitParseField (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseJSON) other0) objectValue "note"  encodeJobPayloadMapped :: JobPayload -> Value encodeJobPayloadMapped = encodeJobPayloadShape . bindingToShape Bindings.jobPayloadBinding@@ -70,7 +70,7 @@   object       [ "job_id" .= toJSON (shape.jobId)       , "label" .= toJSON (shape.label)-      , "metadata" .= maybe Null (\item -> encodeJobMetadataShape (item)) (shape.metadata)+      , "metadata" .= maybe Null (\item0 -> encodeJobMetadataShape (item0)) (shape.metadata)       , "geometry" .= toJSON (shape.geometry)       ] @@ -80,21 +80,21 @@   ShapeJobPayload.JobPayload     <$> explicitParseField (parseJSON) objectValue "job_id"     <*> explicitParseField (parseJSON) objectValue "label"-    <*> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJobMetadataShape other) objectValue "metadata"+    <*> explicitParseField (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseJobMetadataShape) other0) objectValue "metadata"     <*> explicitParseField (parseJSON) objectValue "geometry"  encodeMappedJob :: MappedJob -> Value encodeMappedJob payload =   object     [ "job" .= encodeJobPayloadMapped payload.job-    , "maybe_job" .= maybe Null (\item -> encodeJobPayloadMapped item) (payload.maybeJob)+    , "maybe_job" .= maybe Null (\item0 -> encodeJobPayloadMapped item0) (payload.maybeJob)     , "trace" .= payload.trace     ]  parseMappedJob :: Value -> Either Text MappedJob parseMappedJob = mapLeftText . parseEither (withObject "MappedJob" go)   where-    go objectValue = MappedJob <$> explicitParseField (parseJobPayloadMapped) objectValue "job" <*> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJobPayloadMapped other) objectValue "maybe_job" <*> explicitParseField (pure) objectValue "trace"+    go objectValue = MappedJob <$> explicitParseField (parseJobPayloadMapped) objectValue "job" <*> explicitParseField (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseJobPayloadMapped) other0) objectValue "maybe_job" <*> explicitParseField (pure) objectValue "trace"  mapLeftText :: Either String b -> Either Text b mapLeftText = either (Left . T.pack) Right
test/conformance-mapped-queue/Generated/MappedQueue/MappedJobs/QueueCodec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from workqueue mapped_jobs; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from workqueue mapped_jobs; do not edit. -- | Versioned job payload envelope: @{\"v\",\"t\",\"data\"}@. -- -- Deploy workers before producers when raising its schema version. Do not
test/conformance-mapped-queue/Generated/MappedQueue/MappedJobs/QueuePolicy.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from workqueue mapped_jobs; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from workqueue mapped_jobs; do not edit. module Generated.MappedQueue.MappedJobs.QueuePolicy   ( MappedJobsOutcome (..)   , retryPolicy, jobOutcomeFor@@ -10,7 +10,7 @@ jobOrdering :: JobOrdering jobOrdering = Unordered --- Deployment owns visibility timeout, batch size, and polling; the spec owns ordering.+-- Deployment owns a positive batch size, visibility timeout, and polling; the spec owns ordering. Legacy FIFO modes reject batch sizes greater than one. jobTuningFor :: JobTuning -> JobTuning jobTuningFor = withOrdering jobOrdering
test/conformance-mapped-queue/Generated/MappedQueue/Structural/Shape/JobMetadata.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural JobMetadata; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural JobMetadata; do not edit. module Generated.MappedQueue.Structural.Shape.JobMetadata (JobMetadataShape (..)) where  import Data.Text (Text)
test/conformance-mapped-queue/Generated/MappedQueue/Structural/Shape/JobPayload.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural JobPayload; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural JobPayload; do not edit. module Generated.MappedQueue.Structural.Shape.JobPayload (JobPayloadShape (..)) where  import Data.Text (Text)
test/conformance-mapped-queue/Generated/MappedQueue/StructuralConformance.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context mapped-queue structural conformance; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context mapped-queue structural conformance; do not edit. module Generated.MappedQueue.StructuralConformance   ( structuralConformanceAssertions   ) where@@ -14,7 +14,7 @@ import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape) import Generated.MappedQueue.StructuralProjections qualified as StructuralProjections import Generated.MappedQueue.Structural.Shape.JobMetadata (JobMetadataShape(note))-import Generated.MappedQueue.Structural.Shape.JobPayload (JobPayloadShape(jobId, label, metadata))+import Generated.MappedQueue.Structural.Shape.JobPayload (JobPayloadShape(metadata)) import Conformance.MappedQueue.Bindings qualified as Bindings import Conformance.MappedQueue.Domain (JobMetadata, JobPayload) @@ -82,6 +82,6 @@  structuralProjectionAssertions :: [(String, Bool)] structuralProjectionAssertions =-  [ ("projection witness agreement: conformance.mapped-queue.JobPayload.v1/job_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.jobPayloadJobIdWitness (\referenceOwner -> (bindingToShape Bindings.jobPayloadBinding referenceOwner).jobId) owner) (NonEmpty.toList (fixtureCases Bindings.jobPayloadCases)))-  , ("projection witness agreement: conformance.mapped-queue.JobPayload.v1/label", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.jobPayloadLabelWitness (\referenceOwner -> (bindingToShape Bindings.jobPayloadBinding referenceOwner).label) owner) (NonEmpty.toList (fixtureCases Bindings.jobPayloadCases)))+  [ ("projection witness agreement: conformance.mapped-queue.JobPayload.v1/job_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.jobPayloadJobIdWitness (\referenceOwner -> StructuralProjections.jobPayloadJobIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.jobPayloadCases)))+  , ("projection witness agreement: conformance.mapped-queue.JobPayload.v1/label", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.jobPayloadLabelWitness (\referenceOwner -> StructuralProjections.jobPayloadLabelGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.jobPayloadCases)))   ]
test/conformance-mapped-queue/Generated/MappedQueue/StructuralProjections.hs view
@@ -1,10 +1,13 @@ {-# LANGUAGE TypeFamilies #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context mapped-queue mapped structural facade; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context mapped-queue mapped structural facade; do not edit. -- Equality witnesses are emitted for Text, Int, Bool, Natural, and UTCTime.+-- Nominal ID and enum leaves carry exact canonical-text domains. -- Int, Natural, and UTCTime belong to Keiki's ordered subset. module Generated.MappedQueue.StructuralProjections   ( jobPayloadJobIdWitness+  , jobPayloadJobIdGet   , jobPayloadLabelWitness+  , jobPayloadLabelGet   ) where  import Data.Text (Text)@@ -16,24 +19,30 @@  data JobPayloadJobIdProjection +jobPayloadJobIdGet :: JobPayload -> Text+jobPayloadJobIdGet owner = (bindingToShape Bindings.jobPayloadBinding owner).jobId+ instance FieldProjection JobPayloadJobIdProjection where   type FieldName JobPayloadJobIdProjection = "/job_id"   type FieldOwner JobPayloadJobIdProjection = JobPayload   type FieldResult JobPayloadJobIdProjection = Text   fieldShapeId _ = "conformance.mapped-queue.JobPayload.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.jobPayloadBinding owner).jobId+  projectFieldValue _ = jobPayloadJobIdGet  jobPayloadJobIdWitness :: FieldWitness JobPayloadJobIdProjection jobPayloadJobIdWitness = fieldWitness @JobPayloadJobIdProjection  data JobPayloadLabelProjection +jobPayloadLabelGet :: JobPayload -> Text+jobPayloadLabelGet owner = (bindingToShape Bindings.jobPayloadBinding owner).label+ instance FieldProjection JobPayloadLabelProjection where   type FieldName JobPayloadLabelProjection = "/label"   type FieldOwner JobPayloadLabelProjection = JobPayload   type FieldResult JobPayloadLabelProjection = Text   fieldShapeId _ = "conformance.mapped-queue.JobPayload.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.jobPayloadBinding owner).label+  projectFieldValue _ = jobPayloadLabelGet  jobPayloadLabelWitness :: FieldWitness JobPayloadLabelProjection jobPayloadLabelWitness = fieldWitness @JobPayloadLabelProjection
test/conformance-mapped-readmodel/Generated/MappedReadmodel/AccountSummary/QueryContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel account_summary; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel account_summary; do not edit. module Generated.MappedReadmodel.AccountSummary.QueryContract   ( AccountSummaryQueryInput   , AccountSummaryQueryResult
test/conformance-mapped-readmodel/Generated/MappedReadmodel/AccountSummary/ReadModel.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel account_summary; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel account_summary; do not edit. module Generated.MappedReadmodel.AccountSummary.ReadModel   ( accountSummaryReadModel   , accountSummaryQualifiedTable
test/conformance-mapped-readmodel/Generated/MappedReadmodel/AccountSummary/ReadModelHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel account_summary; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel account_summary; do not edit. module Generated.MappedReadmodel.AccountSummary.ReadModelHarness (readModelFacts, readModelFactResults, runReadModelFacts, catalogFactsAgainst) where  import Generated.MappedReadmodel.AccountSummary.ReadModel (accountSummaryReadModel)
test/conformance-mapped-readmodel/Generated/MappedReadmodel/AccountSummary/ReadModelTable.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel account_summary; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel account_summary; do not edit. module Generated.MappedReadmodel.AccountSummary.ReadModelTable (accountSummaryQualifiedTable) where  import Data.Text (Text)
test/conformance-mapped-readmodel/Generated/MappedReadmodel/ProjectionCatalog.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from projection-catalog mapped-readmodel; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from projection-catalog mapped-readmodel; do not edit. {-# LANGUAGE OverloadedStrings #-} module Generated.MappedReadmodel.ProjectionCatalog   ( projectionCatalog
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/AccountLookup.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural AccountLookup; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural AccountLookup; do not edit. module Generated.MappedReadmodel.Structural.Shape.AccountLookup (AccountLookupShape (..)) where  import Data.Text (Text)
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/AccountProfile.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural AccountProfile; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural AccountProfile; do not edit. module Generated.MappedReadmodel.Structural.Shape.AccountProfile (AccountProfileShape (..)) where  import Data.Text (Text)
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/AccountSummary.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural AccountSummary; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural AccountSummary; do not edit. module Generated.MappedReadmodel.Structural.Shape.AccountSummary (AccountSummaryShape (..)) where  import Data.Text (Text)
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/TenantKey.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural TenantKey; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural TenantKey; do not edit. module Generated.MappedReadmodel.Structural.Shape.TenantKey (TenantKeyShape (..)) where  import Data.Text (Text)
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/UnusedFilter.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from mapped structural UnusedFilter; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from mapped structural UnusedFilter; do not edit. module Generated.MappedReadmodel.Structural.Shape.UnusedFilter (UnusedFilterShape (..)) where  import Data.Text (Text)
test/conformance-mapped-readmodel/Generated/MappedReadmodel/StructuralConformance.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context mapped-readmodel structural conformance; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context mapped-readmodel structural conformance; do not edit. module Generated.MappedReadmodel.StructuralConformance   ( structuralConformanceAssertions   ) where@@ -12,11 +12,7 @@ import Keiki.Shape (CanonicalTypeName (..)) import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape) import Generated.MappedReadmodel.StructuralProjections qualified as StructuralProjections-import Generated.MappedReadmodel.Structural.Shape.AccountLookup (AccountLookupShape(accountId, tenant))-import Generated.MappedReadmodel.Structural.Shape.AccountProfile (AccountProfileShape(displayName))-import Generated.MappedReadmodel.Structural.Shape.AccountSummary (AccountSummaryShape(accountId, profile, tenant))-import Generated.MappedReadmodel.Structural.Shape.TenantKey (TenantKeyShape(tenantId))-import Generated.MappedReadmodel.Structural.Shape.UnusedFilter (UnusedFilterShape(prefix))+import Generated.MappedReadmodel.Structural.Shape.AccountSummary (AccountSummaryShape(profile)) import Conformance.MappedReadModel.Bindings qualified as Bindings import Conformance.MappedReadModel.Domain (AccountLookup, AccountProfile, AccountSummary, TenantKey, UnusedFilter) @@ -126,11 +122,11 @@  structuralProjectionAssertions :: [(String, Bool)] structuralProjectionAssertions =-  [ ("projection witness agreement: conformance.mapped-readmodel.AccountLookup.v1/account_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountLookupAccountIdWitness (\referenceOwner -> (bindingToShape Bindings.accountLookupBinding referenceOwner).accountId) owner) (NonEmpty.toList (fixtureCases Bindings.accountLookupCases)))-  , ("projection witness agreement: conformance.mapped-readmodel.AccountLookup.v1/tenant/tenant_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountLookupTenantTenantIdWitness (\referenceOwner -> ((bindingToShape Bindings.accountLookupBinding referenceOwner).tenant).tenantId) owner) (NonEmpty.toList (fixtureCases Bindings.accountLookupCases)))-  , ("projection witness agreement: conformance.mapped-readmodel.AccountProfile.v1/display_name", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountProfileDisplayNameWitness (\referenceOwner -> (bindingToShape Bindings.accountProfileBinding referenceOwner).displayName) owner) (NonEmpty.toList (fixtureCases Bindings.accountProfileCases)))-  , ("projection witness agreement: conformance.mapped-readmodel.AccountSummary.v1/account_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountSummaryAccountIdWitness (\referenceOwner -> (bindingToShape Bindings.accountSummaryBinding referenceOwner).accountId) owner) (NonEmpty.toList (fixtureCases Bindings.accountSummaryCases)))-  , ("projection witness agreement: conformance.mapped-readmodel.AccountSummary.v1/tenant/tenant_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountSummaryTenantTenantIdWitness (\referenceOwner -> ((bindingToShape Bindings.accountSummaryBinding referenceOwner).tenant).tenantId) owner) (NonEmpty.toList (fixtureCases Bindings.accountSummaryCases)))-  , ("projection witness agreement: conformance.mapped-readmodel.TenantKey.v1/tenant_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.tenantKeyTenantIdWitness (\referenceOwner -> (bindingToShape Bindings.tenantKeyBinding referenceOwner).tenantId) owner) (NonEmpty.toList (fixtureCases Bindings.tenantKeyCases)))-  , ("projection witness agreement: conformance.mapped-readmodel.UnusedFilter.v1/prefix", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.unusedFilterPrefixWitness (\referenceOwner -> (bindingToShape Bindings.unusedFilterBinding referenceOwner).prefix) owner) (NonEmpty.toList (fixtureCases Bindings.unusedFilterCases)))+  [ ("projection witness agreement: conformance.mapped-readmodel.AccountLookup.v1/account_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountLookupAccountIdWitness (\referenceOwner -> StructuralProjections.accountLookupAccountIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.accountLookupCases)))+  , ("projection witness agreement: conformance.mapped-readmodel.AccountLookup.v1/tenant/tenant_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountLookupTenantTenantIdWitness (\referenceOwner -> StructuralProjections.accountLookupTenantTenantIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.accountLookupCases)))+  , ("projection witness agreement: conformance.mapped-readmodel.AccountProfile.v1/display_name", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountProfileDisplayNameWitness (\referenceOwner -> StructuralProjections.accountProfileDisplayNameGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.accountProfileCases)))+  , ("projection witness agreement: conformance.mapped-readmodel.AccountSummary.v1/account_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountSummaryAccountIdWitness (\referenceOwner -> StructuralProjections.accountSummaryAccountIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.accountSummaryCases)))+  , ("projection witness agreement: conformance.mapped-readmodel.AccountSummary.v1/tenant/tenant_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.accountSummaryTenantTenantIdWitness (\referenceOwner -> StructuralProjections.accountSummaryTenantTenantIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.accountSummaryCases)))+  , ("projection witness agreement: conformance.mapped-readmodel.TenantKey.v1/tenant_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.tenantKeyTenantIdWitness (\referenceOwner -> StructuralProjections.tenantKeyTenantIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.tenantKeyCases)))+  , ("projection witness agreement: conformance.mapped-readmodel.UnusedFilter.v1/prefix", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.unusedFilterPrefixWitness (\referenceOwner -> StructuralProjections.unusedFilterPrefixGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.unusedFilterCases)))   ]
test/conformance-mapped-readmodel/Generated/MappedReadmodel/StructuralProjections.hs view
@@ -1,15 +1,23 @@ {-# LANGUAGE TypeFamilies #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context mapped-readmodel mapped structural facade; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context mapped-readmodel mapped structural facade; do not edit. -- Equality witnesses are emitted for Text, Int, Bool, Natural, and UTCTime.+-- Nominal ID and enum leaves carry exact canonical-text domains. -- Int, Natural, and UTCTime belong to Keiki's ordered subset. module Generated.MappedReadmodel.StructuralProjections   ( accountLookupAccountIdWitness+  , accountLookupAccountIdGet   , accountLookupTenantTenantIdWitness+  , accountLookupTenantTenantIdGet   , accountProfileDisplayNameWitness+  , accountProfileDisplayNameGet   , accountSummaryAccountIdWitness+  , accountSummaryAccountIdGet   , accountSummaryTenantTenantIdWitness+  , accountSummaryTenantTenantIdGet   , tenantKeyTenantIdWitness+  , tenantKeyTenantIdGet   , unusedFilterPrefixWitness+  , unusedFilterPrefixGet   ) where  import Data.Text (Text)@@ -25,84 +33,105 @@  data AccountLookupAccountIdProjection +accountLookupAccountIdGet :: AccountLookup -> Text+accountLookupAccountIdGet owner = (bindingToShape Bindings.accountLookupBinding owner).accountId+ instance FieldProjection AccountLookupAccountIdProjection where   type FieldName AccountLookupAccountIdProjection = "/account_id"   type FieldOwner AccountLookupAccountIdProjection = AccountLookup   type FieldResult AccountLookupAccountIdProjection = Text   fieldShapeId _ = "conformance.mapped-readmodel.AccountLookup.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.accountLookupBinding owner).accountId+  projectFieldValue _ = accountLookupAccountIdGet  accountLookupAccountIdWitness :: FieldWitness AccountLookupAccountIdProjection accountLookupAccountIdWitness = fieldWitness @AccountLookupAccountIdProjection  data AccountLookupTenantTenantIdProjection +accountLookupTenantTenantIdGet :: AccountLookup -> Text+accountLookupTenantTenantIdGet owner = ((bindingToShape Bindings.accountLookupBinding owner).tenant).tenantId+ instance FieldProjection AccountLookupTenantTenantIdProjection where   type FieldName AccountLookupTenantTenantIdProjection = "/tenant/tenant_id"   type FieldOwner AccountLookupTenantTenantIdProjection = AccountLookup   type FieldResult AccountLookupTenantTenantIdProjection = Text   fieldShapeId _ = "conformance.mapped-readmodel.AccountLookup.v1"-  projectFieldValue _ owner = ((bindingToShape Bindings.accountLookupBinding owner).tenant).tenantId+  projectFieldValue _ = accountLookupTenantTenantIdGet  accountLookupTenantTenantIdWitness :: FieldWitness AccountLookupTenantTenantIdProjection accountLookupTenantTenantIdWitness = fieldWitness @AccountLookupTenantTenantIdProjection  data AccountProfileDisplayNameProjection +accountProfileDisplayNameGet :: AccountProfile -> Text+accountProfileDisplayNameGet owner = (bindingToShape Bindings.accountProfileBinding owner).displayName+ instance FieldProjection AccountProfileDisplayNameProjection where   type FieldName AccountProfileDisplayNameProjection = "/display_name"   type FieldOwner AccountProfileDisplayNameProjection = AccountProfile   type FieldResult AccountProfileDisplayNameProjection = Text   fieldShapeId _ = "conformance.mapped-readmodel.AccountProfile.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.accountProfileBinding owner).displayName+  projectFieldValue _ = accountProfileDisplayNameGet  accountProfileDisplayNameWitness :: FieldWitness AccountProfileDisplayNameProjection accountProfileDisplayNameWitness = fieldWitness @AccountProfileDisplayNameProjection  data AccountSummaryAccountIdProjection +accountSummaryAccountIdGet :: AccountSummary -> Text+accountSummaryAccountIdGet owner = (bindingToShape Bindings.accountSummaryBinding owner).accountId+ instance FieldProjection AccountSummaryAccountIdProjection where   type FieldName AccountSummaryAccountIdProjection = "/account_id"   type FieldOwner AccountSummaryAccountIdProjection = AccountSummary   type FieldResult AccountSummaryAccountIdProjection = Text   fieldShapeId _ = "conformance.mapped-readmodel.AccountSummary.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.accountSummaryBinding owner).accountId+  projectFieldValue _ = accountSummaryAccountIdGet  accountSummaryAccountIdWitness :: FieldWitness AccountSummaryAccountIdProjection accountSummaryAccountIdWitness = fieldWitness @AccountSummaryAccountIdProjection  data AccountSummaryTenantTenantIdProjection +accountSummaryTenantTenantIdGet :: AccountSummary -> Text+accountSummaryTenantTenantIdGet owner = ((bindingToShape Bindings.accountSummaryBinding owner).tenant).tenantId+ instance FieldProjection AccountSummaryTenantTenantIdProjection where   type FieldName AccountSummaryTenantTenantIdProjection = "/tenant/tenant_id"   type FieldOwner AccountSummaryTenantTenantIdProjection = AccountSummary   type FieldResult AccountSummaryTenantTenantIdProjection = Text   fieldShapeId _ = "conformance.mapped-readmodel.AccountSummary.v1"-  projectFieldValue _ owner = ((bindingToShape Bindings.accountSummaryBinding owner).tenant).tenantId+  projectFieldValue _ = accountSummaryTenantTenantIdGet  accountSummaryTenantTenantIdWitness :: FieldWitness AccountSummaryTenantTenantIdProjection accountSummaryTenantTenantIdWitness = fieldWitness @AccountSummaryTenantTenantIdProjection  data TenantKeyTenantIdProjection +tenantKeyTenantIdGet :: TenantKey -> Text+tenantKeyTenantIdGet owner = (bindingToShape Bindings.tenantKeyBinding owner).tenantId+ instance FieldProjection TenantKeyTenantIdProjection where   type FieldName TenantKeyTenantIdProjection = "/tenant_id"   type FieldOwner TenantKeyTenantIdProjection = TenantKey   type FieldResult TenantKeyTenantIdProjection = Text   fieldShapeId _ = "conformance.mapped-readmodel.TenantKey.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.tenantKeyBinding owner).tenantId+  projectFieldValue _ = tenantKeyTenantIdGet  tenantKeyTenantIdWitness :: FieldWitness TenantKeyTenantIdProjection tenantKeyTenantIdWitness = fieldWitness @TenantKeyTenantIdProjection  data UnusedFilterPrefixProjection +unusedFilterPrefixGet :: UnusedFilter -> Text+unusedFilterPrefixGet owner = (bindingToShape Bindings.unusedFilterBinding owner).prefix+ instance FieldProjection UnusedFilterPrefixProjection where   type FieldName UnusedFilterPrefixProjection = "/prefix"   type FieldOwner UnusedFilterPrefixProjection = UnusedFilter   type FieldResult UnusedFilterPrefixProjection = Text   fieldShapeId _ = "conformance.mapped-readmodel.UnusedFilter.v1"-  projectFieldValue _ owner = (bindingToShape Bindings.unusedFilterBinding owner).prefix+  projectFieldValue _ = unusedFilterPrefixGet  unusedFilterPrefixWitness :: FieldWitness UnusedFilterPrefixProjection unusedFilterPrefixWitness = fieldWitness @UnusedFilterPrefixProjection
test/conformance-newsurface/Generated/TransferRouting/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context transfer-routing behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context transfer-routing behavior source map; do not edit. module Generated.TransferRouting.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-newsurface/Generated/TransferRouting/Hospital/BehaviorContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-newsurface/Generated/TransferRouting/Hospital/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Codec (     hospitalCodec,     parseHospitalEvent,
test/conformance-newsurface/Generated/TransferRouting/Hospital/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Domain where  import Data.Text (Text)
test/conformance-newsurface/Generated/TransferRouting/Hospital/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.EventStream   ( hospitalCategory   , hospitalCommandCategory
test/conformance-newsurface/Generated/TransferRouting/Hospital/Harness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Harness (harnessAssertions) where  import Generated.TransferRouting.Hospital.Domain
test/conformance-newsurface/Generated/TransferRouting/Hospital/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-newsurface/Generated/TransferRouting/Hospital/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.TransferRouting.Hospital.Transducer   ( hospitalTransducer   , hospitalFoldFingerprint
test/conformance-newsurface/Generated/TransferRouting/HospitalLoad/ReadModel.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel hospital_load; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel hospital_load; do not edit. module Generated.TransferRouting.HospitalLoad.ReadModel   ( hospitalLoadReadModel   , hospitalLoadQualifiedTable
test/conformance-newsurface/Generated/TransferRouting/HospitalLoad/ReadModelHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel hospital_load; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel hospital_load; do not edit. module Generated.TransferRouting.HospitalLoad.ReadModelHarness (readModelFacts, readModelFactResults, runReadModelFacts) where  import Generated.TransferRouting.HospitalLoad.ReadModel (hospitalLoadReadModel, hospitalLoadAsyncProjection)
test/conformance-newsurface/Generated/TransferRouting/HospitalLoad/ReadModelTable.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from readmodel hospital_load; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from readmodel hospital_load; do not edit. module Generated.TransferRouting.HospitalLoad.ReadModelTable (hospitalLoadQualifiedTable) where  import Data.Text (Text)
test/conformance-newsurface/Generated/TransferRouting/HospitalTransferRouter/Router.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from router HospitalTransferRouter; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from router HospitalTransferRouter; do not edit. module Generated.TransferRouting.HospitalTransferRouter.Router   ( hospitalTransferRouterName   , hospitalTransferRouterWorkerOptions
test/conformance-newsurface/Generated/TransferRouting/HospitalTransferRouter/RouterHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from router HospitalTransferRouter; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from router HospitalTransferRouter; do not edit. module Generated.TransferRouting.HospitalTransferRouter.RouterHarness (routerHarnessValues) where  routerHarnessValues :: [(String, String)]
test/conformance-newsurface/Generated/TransferRouting/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context transfer-routing replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context transfer-routing replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
+ test/conformance-nominal-query-only/Generated/MappedNominalQueryOnly/Nominals.hs view
@@ -0,0 +1,9 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context mapped-nominal-query-only generated nominal declarations; do not edit.+module Generated.MappedNominalQueryOnly.Nominals+  ( TemplateId+  , parseTemplateId+  , mkTemplateId+  , templateIdText+  ) where++import Generated.MappedNominalQueryOnly.Nominals.Internal (TemplateId, mkTemplateId, parseTemplateId, templateIdText)
+ test/conformance-nominal-query-only/Generated/MappedNominalQueryOnly/Nominals/Internal.hs view
@@ -0,0 +1,40 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context mapped-nominal-query-only generated nominal ID internals; do not edit.+module Generated.MappedNominalQueryOnly.Nominals.Internal+  ( TemplateId+  , parseTemplateId+  , mkTemplateId+  , templateIdText+  , unsafeTemplateIdFromLegacyText+  ) 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)++newtype TemplateId = TemplateId Text+  deriving stock (Generic, Eq, Ord, Show)++instance CanonicalTypeName TemplateId++instance ToJSON TemplateId where+  toJSON = toJSON . templateIdText++instance FromJSON TemplateId where+  parseJSON = withText "TemplateId" (either (fail . T.unpack) pure . parseTemplateId)++parseTemplateId :: Text -> Either Text TemplateId+parseTemplateId input = case validateIdDomainText (typeIdV7Domain "template") input of+  Left reason -> Left (T.pack (show reason))+  Right () -> Right (TemplateId input)++mkTemplateId :: Text -> Either Text TemplateId+mkTemplateId = parseTemplateId++templateIdText :: TemplateId -> Text+templateIdText (TemplateId value) = value++unsafeTemplateIdFromLegacyText :: Text -> TemplateId+unsafeTemplateIdFromLegacyText = TemplateId
+ test/conformance-nominal-query-only/Generated/MappedNominalQueryOnly/ProjectionCatalog.hs view
@@ -0,0 +1,80 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from projection-catalog mapped-nominal-query-only; do not edit.+{-# LANGUAGE OverloadedStrings #-}+module Generated.MappedNominalQueryOnly.ProjectionCatalog+  ( projectionCatalog+  , validatedProjectionCatalog+  , projectionCatalogInventory+  , projectionCatalogRegistrations+  , projectionCatalogAsyncRegistrations+  , projectionCatalogQuerySupplies+  , registerProjectionCatalog+  , templateWriterProjectionSet+  , templateRebuildRebuildGroupId+  , startTemplateRebuildRebuild+  ) where++import Data.List.NonEmpty (NonEmpty (..))+import Effectful (Eff, IOE, (:>))+import Keiro.Projection (AsyncProjection (..))+import Keiro.Projection.Catalog qualified as Catalog+import Keiro.ReadModel.Rebuild qualified as Rebuild+import Kiroku.Store.Effect (Store)+import Kiroku.Store.Subscription.Types qualified as KirokuSubscription+import MappedNominalQueryOnly.ProjectionCatalog.ProjectionCatalogHoles qualified as Holes+import Generated.MappedNominalQueryOnly.TemplateLookup.ReadModel qualified as RMTemplateLookup++must :: Show error => Either error value -> value+must = either (error . show) id++templateWriterProjectionSet :: Catalog.ProjectionSet Holes.TemplateWriterEvent+templateWriterProjectionSet =+  Catalog.ProjectionSet+    (must (Catalog.mkSourceId "all"))+    (Catalog.ProjectionDefinition+      (must (Catalog.mkProjectionId "template_writer"))+      (must (Catalog.mkRebuildGroupId "template_rebuild"))+      ((must (Catalog.mkTargetId "template_table")) :| [])+      (Catalog.Replayable (Catalog.ReplayAdapter Holes.decodeTemplateWriterReplay Holes.applyTemplateWriterReplay))+      (Catalog.AsyncHandler (AsyncProjection "template-writer-v1" "mapped-nominal-query-only-template-lookup" "template-writer" Holes.applyTemplateWriterLive Holes.templateWriterIdempotencyKey) (must (Catalog.mkSubscriptionId "template-writer")) (must (Catalog.mkDedupKeyId "template-writer-v1")) (must (Catalog.mkClaimSite "projection-owner template_writer async-handler")) :| [])+      (must (Catalog.mkClaimSite "projection-owner template_writer"))+      :| [])+    (must (Catalog.mkClaimSite "projection-owner template_writer source"))++projectionCatalog :: Catalog.ProjectionCatalog+projectionCatalog =+  Catalog.ProjectionCatalog+    [Catalog.SourceDeclaration (must (Catalog.mkSourceId "all")) Catalog.AllStreams "all-streams/generated-codec/v1" (must (Catalog.mkClaimSite "source all"))]+    [Catalog.TargetDeclaration (must (Catalog.mkTargetId "template_table")) (Catalog.QualifiedTable "public" "templates") Catalog.ClearBeforeReplay [] (must (Catalog.mkClaimSite "target template_table"))]+    [Catalog.RebuildGroupDeclaration (must (Catalog.mkRebuildGroupId "template_rebuild")) [(must (Catalog.mkTargetId "template_table"))] [] (must (Catalog.mkClaimSite "rebuild-group template_rebuild"))]+    []+    []+    [Catalog.SubscriptionDeclaration (must (Catalog.mkSubscriptionId "template-writer")) "template-writer" (must (Catalog.mkSourceId "all")) KirokuSubscription.FromBeginning (must (Catalog.mkClaimSite "projection-owner template_writer subscription"))]+    [Catalog.DedupKeyDeclaration (must (Catalog.mkDedupKeyId "template-writer-v1")) "template-writer-v1" (must (Catalog.mkClaimSite "projection-owner template_writer dedup"))]+    [Catalog.SomeQueryModelBinding (Catalog.QueryModelBinding (must (Catalog.mkQueryModelId "template_lookup")) RMTemplateLookup.templateLookupReadModel (must (Catalog.mkRebuildGroupId "template_rebuild")) [(must (Catalog.mkTargetId "template_table"))] (must (Catalog.mkClaimSite "readmodel template_lookup")))]+    [Catalog.SomeProjectionSet templateWriterProjectionSet]++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++templateRebuildRebuildGroupId :: Catalog.RebuildGroupId+templateRebuildRebuildGroupId = (must (Catalog.mkRebuildGroupId "template_rebuild"))++startTemplateRebuildRebuild :: (IOE :> es, Store :> es) => Rebuild.RebuildOptions -> Eff es (Either Rebuild.CatalogRebuildError Rebuild.RebuildRunReport)+startTemplateRebuildRebuild = Rebuild.startCatalogRebuild validatedProjectionCatalog templateRebuildRebuildGroupId
+ test/conformance-nominal-query-only/Generated/MappedNominalQueryOnly/StructuralConformance.hs view
@@ -0,0 +1,9 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context mapped-nominal-query-only structural conformance; do not edit.+module Generated.MappedNominalQueryOnly.StructuralConformance+  ( structuralConformanceAssertions+  ) where+++structuralConformanceAssertions :: [(String, Bool)]+structuralConformanceAssertions =+  []
+ test/conformance-nominal-query-only/Generated/MappedNominalQueryOnly/TemplateLookup/QueryContract.hs view
@@ -0,0 +1,10 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from readmodel template_lookup; do not edit.+module Generated.MappedNominalQueryOnly.TemplateLookup.QueryContract+  ( TemplateLookupQueryInput+  , TemplateLookupQueryResult+  ) where++import Generated.MappedNominalQueryOnly.Nominals (TemplateId)++type TemplateLookupQueryInput = TemplateId+type TemplateLookupQueryResult = [TemplateId]
+ test/conformance-nominal-query-only/Generated/MappedNominalQueryOnly/TemplateLookup/ReadModel.hs view
@@ -0,0 +1,28 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from readmodel template_lookup; do not edit.+module Generated.MappedNominalQueryOnly.TemplateLookup.ReadModel+  ( templateLookupReadModel+  , templateLookupQualifiedTable+  ) where++import Generated.MappedNominalQueryOnly.TemplateLookup.ReadModelTable (templateLookupQualifiedTable)+import Generated.MappedNominalQueryOnly.TemplateLookup.QueryContract (TemplateLookupQueryInput, TemplateLookupQueryResult)+import MappedNominalQueryOnly.TemplateLookup.ReadModelHoles (templateLookupQuery)+import Keiro.ReadModel (QueryCursorAuthority (..), ReadModel, ReadModelBlueprint (..), HeadScope (..), headWaitingReadModel)++templateLookupReadModel :: ReadModel TemplateLookupQueryInput TemplateLookupQueryResult+templateLookupReadModel =+  case headWaitingReadModel EntireVisibleLog templateLookupReadModelBlueprint of+    Left definitionError -> error ("keiro-dsl generated an invalid waiting read model: " <> show definitionError)+    Right model -> model++templateLookupReadModelBlueprint :: ReadModelBlueprint TemplateLookupQueryInput TemplateLookupQueryResult+templateLookupReadModelBlueprint =+  ReadModelBlueprint+    { name = "mapped-nominal-query-only-template-lookup"+    , tableName = "templates"+    , schema = "public"+    , version = 1+    , shapeHash = "fnv1a:3c07a19c552c3547"+    , cursorAuthority = DurableQueryCursor "template-writer"+    , query = templateLookupQuery+    }
+ test/conformance-nominal-query-only/Generated/MappedNominalQueryOnly/TemplateLookup/ReadModelHarness.hs view
@@ -0,0 +1,57 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from readmodel template_lookup; do not edit.+module Generated.MappedNominalQueryOnly.TemplateLookup.ReadModelHarness (readModelFacts, readModelFactResults, runReadModelFacts, catalogFactsAgainst) where++import Generated.MappedNominalQueryOnly.TemplateLookup.ReadModel (templateLookupReadModel)+import Data.Text qualified as T+import Data.List.NonEmpty qualified as NE+import Generated.MappedNominalQueryOnly.ProjectionCatalog qualified as ProjectionCatalog+import Keiro.Projection.Catalog qualified as Catalog+import Keiro.ReadModel (ReadModel (..), readModelCursorAuthority, readModelDefaultFreshness)++-- | (fact, expected from notation, actual generated runtime value).+readModelFacts :: [(String, String, String)]+readModelFacts =+  [ ("registryName", "mapped-nominal-query-only-template-lookup", T.unpack templateLookupReadModel.name)+  , ("shapeHash", "fnv1a:3c07a19c552c3547", T.unpack templateLookupReadModel.shapeHash)+  , ("freshness", "WaitForHead EntireVisibleLog", show (readModelDefaultFreshness templateLookupReadModel))+  , ("cursorAuthority", "DurableQueryCursor \"template-writer\"", show (readModelCursorAuthority templateLookupReadModel))+  ]+    <> catalogFactsAgainst ProjectionCatalog.projectionCatalogRegistrations ProjectionCatalog.projectionCatalogAsyncRegistrations ProjectionCatalog.projectionCatalogQuerySupplies++catalogFactsAgainst :: [Catalog.CatalogRegistration] -> [Catalog.AsyncProjectionRegistration] -> [Catalog.ResolvedQuerySupply] -> [(String, String, String)]+catalogFactsAgainst registrations asyncRegistrations supplies =+  [ ("catalogRegistration", "mapped-nominal-query-only-template-lookup|1|fnv1a:3c07a19c552c3547|template_rebuild", renderRegistration [entry | entry <- registrations, Catalog.queryModelIdText entry.queryModelId == "template_lookup"])+  , ("querySupply", "template_writer|template_rebuild|template_table", renderSupply [entry | entry <- supplies, Catalog.queryModelIdText entry.resolvedQueryModelId == "template_lookup"])+  , ("projectionDelivery", "subscription", renderDelivery [entry | entry <- supplies, Catalog.queryModelIdText entry.resolvedQueryModelId == "template_lookup"])+  , ("asyncRegistration:template_writer", "template-writer|template-writer-v1", renderAsync [entry | entry <- asyncRegistrations, Catalog.projectionIdText entry.projectionId == "template_writer"])+  ]++renderRegistration :: [Catalog.CatalogRegistration] -> String+renderRegistration [entry] = T.unpack entry.registryName <> "|" <> show entry.version <> "|" <> T.unpack entry.shapeHash <> "|" <> T.unpack (Catalog.rebuildGroupIdText entry.rebuildGroupId)+renderRegistration _ = "missing"++renderSupply :: [Catalog.ResolvedQuerySupply] -> String+renderSupply [entry] = T.unpack (Catalog.projectionIdText entry.resolvedProjectionId) <> "|" <> T.unpack (Catalog.rebuildGroupIdText entry.resolvedRebuildGroupId) <> "|" <> T.unpack (T.intercalate "," (map Catalog.targetIdText (NE.toList entry.resolvedObservedTargets)))+renderSupply _ = "missing"++renderDelivery :: [Catalog.ResolvedQuerySupply] -> String+renderDelivery [entry] = T.unpack (T.intercalate "," (map renderCapability (NE.toList entry.resolvedHandlerCapabilities)))+renderDelivery _ = "missing"++renderCapability :: Catalog.ProjectionHandlerCapability -> T.Text+renderCapability Catalog.InlineCapability {} = "inline"+renderCapability Catalog.SubscriptionCapability {} = "subscription"++renderAsync :: [Catalog.AsyncProjectionRegistration] -> String+renderAsync [entry] = T.unpack entry.subscriptionName <> "|" <> T.unpack entry.dedupName+renderAsync _ = "missing"++readModelFactResults :: [(String, Bool)]+readModelFactResults =+  [(fact, expected == actual) | (fact, expected, actual) <- readModelFacts]++runReadModelFacts :: IO Bool+runReadModelFacts = do+  let failures = [(fact, expected, actual) | (fact, expected, actual) <- readModelFacts, expected /= actual]+  mapM_ (\(fact, expected, actual) -> putStrLn ("FAIL  " <> fact <> " expected=" <> show expected <> " actual=" <> show actual)) failures+  pure (null failures)
+ test/conformance-nominal-query-only/Generated/MappedNominalQueryOnly/TemplateLookup/ReadModelTable.hs view
@@ -0,0 +1,9 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from readmodel template_lookup; do not edit.+module Generated.MappedNominalQueryOnly.TemplateLookup.ReadModelTable (templateLookupQualifiedTable) where++import Data.Text (Text)+import Keiro.Connection (qualifyTable)++-- The fully-qualified, double-quoted data-table reference.+templateLookupQualifiedTable :: Text+templateLookupQualifiedTable = qualifyTable "public" "templates"
+ test/conformance-nominal-query-only/MappedNominalQueryOnly/ProjectionCatalog/ProjectionCatalogHoles.hs view
@@ -0,0 +1,23 @@+-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never overwrites it.+module MappedNominalQueryOnly.ProjectionCatalog.ProjectionCatalogHoles+  ( TemplateWriterEvent (..)+  , applyTemplateWriterLive+  , templateWriterIdempotencyKey+  , applyTemplateWriterReplay+  , decodeTemplateWriterReplay+  ) where++import Hasql.Transaction qualified as Tx+import Keiro.Projection.Catalog qualified as Catalog+import Kiroku.Store.Types (EventId, RecordedEvent)++-- Projection owner template_writer (order 10).+data TemplateWriterEvent = TemplateWriterEvent+applyTemplateWriterLive :: RecordedEvent -> Tx.Transaction ()+applyTemplateWriterLive = error "HOLE: fill template_writer live apply"+templateWriterIdempotencyKey :: RecordedEvent -> EventId+templateWriterIdempotencyKey = error "HOLE: return the durable event id for template_writer"+decodeTemplateWriterReplay :: RecordedEvent -> Catalog.ReplayDecodeResult TemplateWriterEvent+decodeTemplateWriterReplay = error "HOLE: classify and decode every template_writer source event"+applyTemplateWriterReplay :: TemplateWriterEvent -> RecordedEvent -> Tx.Transaction ()+applyTemplateWriterReplay = error "HOLE: fill template_writer replay apply without live-only side effects"
+ test/conformance-nominal-query-only/MappedNominalQueryOnly/TemplateLookup/ReadModelHoles.hs view
@@ -0,0 +1,14 @@+-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never overwrites it.+module MappedNominalQueryOnly.TemplateLookup.ReadModelHoles+  ( templateLookupQuery+  ) where++import Generated.MappedNominalQueryOnly.TemplateLookup.ReadModelTable (templateLookupQualifiedTable)+import Generated.MappedNominalQueryOnly.TemplateLookup.QueryContract (TemplateLookupQueryInput, TemplateLookupQueryResult)+import Hasql.Transaction qualified as Tx++-- HOLE: query "public"."templates" via templateLookupQualifiedTable; never rely on search_path.+-- The generated QueryContract owns query input/result type identity.+-- Declared columns:+templateLookupQuery :: TemplateLookupQueryInput -> Tx.Transaction TemplateLookupQueryResult+templateLookupQuery _input = templateLookupQualifiedTable `seq` error "HOLE: fill template_lookup query"
+ test/conformance-nominal-query-only/keiro-dsl-cabal-fragment.context.mapped-nominal-query-only.txt view
@@ -0,0 +1,31 @@+-- keiro-dsl build manifest for keiro-dsl/test/fixtures/mapped-nominal-query-only.keiro+-- Paste the complete fragment below into the consuming Cabal stanza.+-- The generated layer is overwritten on every scaffold; hole modules are+-- create-if-absent (filled by hand).++default-language: GHC2024+default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings++other-modules:+    Generated.MappedNominalQueryOnly.Nominals+    Generated.MappedNominalQueryOnly.Nominals.Internal+    Generated.MappedNominalQueryOnly.ProjectionCatalog+    Generated.MappedNominalQueryOnly.StructuralConformance+    Generated.MappedNominalQueryOnly.TemplateLookup.QueryContract+    Generated.MappedNominalQueryOnly.TemplateLookup.ReadModel+    Generated.MappedNominalQueryOnly.TemplateLookup.ReadModelHarness+    Generated.MappedNominalQueryOnly.TemplateLookup.ReadModelTable+    MappedNominalQueryOnly.ProjectionCatalog.ProjectionCatalogHoles+    MappedNominalQueryOnly.TemplateLookup.ReadModelHoles++build-depends:+    , base+    , effectful-core+    , hasql-transaction+    , keiro+    , kiroku-store+    , text
+ test/conformance-nominal-query-only/keiro-dsl-ledger.context.mapped-nominal-query-only.txt view
@@ -0,0 +1,41 @@+keiro-dsl scaffold record v1+spec: keiro-dsl/test/fixtures/mapped-nominal-query-only.keiro+module-root: (none)+layout: prefixed+source-language {"declaredLanguageVersion":6,"effectiveLanguageVersion":6,"sourceForm":"declared"}+semantic-contract {"languageSupport":"candidate","languageVersion":6,"runtimeSemantics":"keiro-dsl/runtime-semantics/5"}+naming-edition idiomatic-v2+module-role {"family":"StructuralConformance","kind":"generated","ownerKind":"context","ownerName":"context mapped-nominal-query-only structural conformance","path":"Generated/MappedNominalQueryOnly/StructuralConformance.hs"}+module-role {"family":"Nominals","kind":"generated","ownerKind":"context","ownerName":"context mapped-nominal-query-only generated nominal declarations","path":"Generated/MappedNominalQueryOnly/Nominals.hs"}+module-role {"family":"Internal","kind":"generated","ownerKind":"context","ownerName":"context mapped-nominal-query-only generated nominal ID internals","path":"Generated/MappedNominalQueryOnly/Nominals/Internal.hs"}+module-role {"family":"ProjectionCatalog","kind":"generated","ownerKind":"projection-catalog","ownerName":"projection-catalog mapped-nominal-query-only","path":"Generated/MappedNominalQueryOnly/ProjectionCatalog.hs"}+module-role {"family":"ProjectionCatalogHoles","kind":"hole","ownerKind":"projection-catalog","ownerName":"projection-catalog mapped-nominal-query-only","path":"MappedNominalQueryOnly/ProjectionCatalog/ProjectionCatalogHoles.hs"}+module-role {"family":"ReadModelTable","kind":"generated","ownerKind":"readmodel","ownerName":"readmodel template_lookup (line 29)","path":"Generated/MappedNominalQueryOnly/TemplateLookup/ReadModelTable.hs"}+module-role {"family":"QueryContract","kind":"generated","ownerKind":"readmodel","ownerName":"readmodel template_lookup (line 29)","path":"Generated/MappedNominalQueryOnly/TemplateLookup/QueryContract.hs"}+module-role {"family":"ReadModel","kind":"generated","ownerKind":"readmodel","ownerName":"readmodel template_lookup (line 29)","path":"Generated/MappedNominalQueryOnly/TemplateLookup/ReadModel.hs"}+module-role {"family":"ReadModelHoles","kind":"hole","ownerKind":"readmodel","ownerName":"readmodel template_lookup (line 29)","path":"MappedNominalQueryOnly/TemplateLookup/ReadModelHoles.hs"}+module-role {"family":"ReadModelHarness","kind":"generated","ownerKind":"readmodel","ownerName":"readmodel template_lookup (line 29)","path":"Generated/MappedNominalQueryOnly/TemplateLookup/ReadModelHarness.hs"}+generated Generated/MappedNominalQueryOnly/StructuralConformance.hs+generated Generated/MappedNominalQueryOnly/Nominals.hs+generated Generated/MappedNominalQueryOnly/Nominals/Internal.hs+generated Generated/MappedNominalQueryOnly/ProjectionCatalog.hs+hole MappedNominalQueryOnly/ProjectionCatalog/ProjectionCatalogHoles.hs+generated Generated/MappedNominalQueryOnly/TemplateLookup/ReadModelTable.hs+generated Generated/MappedNominalQueryOnly/TemplateLookup/QueryContract.hs+generated Generated/MappedNominalQueryOnly/TemplateLookup/ReadModel.hs+hole MappedNominalQueryOnly/TemplateLookup/ReadModelHoles.hs+generated Generated/MappedNominalQueryOnly/TemplateLookup/ReadModelHarness.hs+id-domain id-domain|name=TemplateId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=template|separator=_|json=canonical-json-text+nominal-equality nominal-equality|name=TemplateId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:template:keiro-dsl/id-domain/typeid-v7/1|owner=generated+projection-catalog-fact cursor|template_lookup|template-writer|29+projection-catalog-fact delivery|template_writer|subscription|17+projection-catalog-fact freshness|template_lookup|wait-for-head:entire-log|29+projection-catalog-fact group|template_rebuild|template_table|template_table|12+projection-catalog-fact owner|template_writer|all|template_rebuild|template_table|10|template-writer|template-writer-v1|from-beginning|explicit|17+projection-catalog-fact query|template_lookup|template_rebuild|template_table|template_table|29+projection-catalog-fact supply|template_lookup|template_writer|template_rebuild|template_table|29|17+projection-catalog-fact target|template_table|public|templates|clear||6+query-contract-baseline v1+query-contract {"mappedDependencies":[],"position":"input","readModel":"template_lookup","typeExpression":"TemplateId"}+query-contract {"mappedDependencies":[],"position":"result","readModel":"template_lookup","typeExpression":"List TemplateId"}+semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
+ test/conformance-nominal-queue-only/Generated/MappedNominalQueueOnly/Nominals.hs view
@@ -0,0 +1,9 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context mapped-nominal-queue-only generated nominal declarations; do not edit.+module Generated.MappedNominalQueueOnly.Nominals+  ( TemplateId+  , parseTemplateId+  , mkTemplateId+  , templateIdText+  ) where++import Generated.MappedNominalQueueOnly.Nominals.Internal (TemplateId, mkTemplateId, parseTemplateId, templateIdText)
+ test/conformance-nominal-queue-only/Generated/MappedNominalQueueOnly/Nominals/Internal.hs view
@@ -0,0 +1,40 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context mapped-nominal-queue-only generated nominal ID internals; do not edit.+module Generated.MappedNominalQueueOnly.Nominals.Internal+  ( TemplateId+  , parseTemplateId+  , mkTemplateId+  , templateIdText+  , unsafeTemplateIdFromLegacyText+  ) 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)++newtype TemplateId = TemplateId Text+  deriving stock (Generic, Eq, Ord, Show)++instance CanonicalTypeName TemplateId++instance ToJSON TemplateId where+  toJSON = toJSON . templateIdText++instance FromJSON TemplateId where+  parseJSON = withText "TemplateId" (either (fail . T.unpack) pure . parseTemplateId)++parseTemplateId :: Text -> Either Text TemplateId+parseTemplateId input = case validateIdDomainText (typeIdV7Domain "template") input of+  Left reason -> Left (T.pack (show reason))+  Right () -> Right (TemplateId input)++mkTemplateId :: Text -> Either Text TemplateId+mkTemplateId = parseTemplateId++templateIdText :: TemplateId -> Text+templateIdText (TemplateId value) = value++unsafeTemplateIdFromLegacyText :: Text -> TemplateId+unsafeTemplateIdFromLegacyText = TemplateId
+ test/conformance-nominal-queue-only/Generated/MappedNominalQueueOnly/Structural/NominalLeaves.hs view
@@ -0,0 +1,15 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context mapped-nominal-queue-only structural nominal leaves; do not edit.+module Generated.MappedNominalQueueOnly.Structural.NominalLeaves where++import Data.Aeson (Value (..), withText)+import Data.Aeson.Types (Parser)+import Data.Text qualified as T+import Generated.MappedNominalQueueOnly.Nominals qualified as Nominals++encodeTemplateIdLeaf :: Nominals.TemplateId -> Value+encodeTemplateIdLeaf = String . Nominals.templateIdText+{-# NOINLINE encodeTemplateIdLeaf #-}++parseTemplateIdLeaf :: Value -> Parser Nominals.TemplateId+parseTemplateIdLeaf = withText "TemplateId" (either (fail . T.unpack) pure . Nominals.parseTemplateId)+{-# NOINLINE parseTemplateIdLeaf #-}
+ test/conformance-nominal-queue-only/Generated/MappedNominalQueueOnly/StructuralConformance.hs view
@@ -0,0 +1,9 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context mapped-nominal-queue-only structural conformance; do not edit.+module Generated.MappedNominalQueueOnly.StructuralConformance+  ( structuralConformanceAssertions+  ) where+++structuralConformanceAssertions :: [(String, Bool)]+structuralConformanceAssertions =+  []
+ test/conformance-nominal-queue-only/Generated/MappedNominalQueueOnly/TemplateWork/Queue.hs view
@@ -0,0 +1,39 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from workqueue template_work; do not edit.+module Generated.MappedNominalQueueOnly.TemplateWork.Queue+  ( TemplateWork (..)+  , encodeTemplateWork+  , parseTemplateWork+  , queuePhysical, queueDlq, queueTable++  ) where++import Data.Aeson (Value (..), object, withObject, (.=))+import Data.Aeson.Types (explicitParseField, parseEither)+import Data.Text (Text)+import qualified Data.Text as T+import Generated.MappedNominalQueueOnly.Structural.NominalLeaves (encodeTemplateIdLeaf, parseTemplateIdLeaf)+import Generated.MappedNominalQueueOnly.Nominals (TemplateId)++queuePhysical, queueDlq, queueTable :: Text+queuePhysical = "template_work"+queueDlq = "template_work_dlq"+queueTable = "pgmq.q_template_work"++data TemplateWork = TemplateWork+  { templateId :: !(Maybe TemplateId)+  }+  deriving stock (Eq, Show)++encodeTemplateWork :: TemplateWork -> Value+encodeTemplateWork payload =+  object+    [ "template_id" .= maybe Null (\item0 -> encodeTemplateIdLeaf item0) (payload.templateId)+    ]++parseTemplateWork :: Value -> Either Text TemplateWork+parseTemplateWork = mapLeftText . parseEither (withObject "TemplateWork" go)+  where+    go objectValue = TemplateWork <$> explicitParseField (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseTemplateIdLeaf) other0) objectValue "template_id"++mapLeftText :: Either String b -> Either Text b+mapLeftText = either (Left . T.pack) Right
+ test/conformance-nominal-queue-only/Generated/MappedNominalQueueOnly/TemplateWork/QueueCodec.hs view
@@ -0,0 +1,29 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from workqueue template_work; do not edit.+-- | 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 Generated.MappedNominalQueueOnly.TemplateWork.QueueCodec (templateWorkPayloadCodec, templateWorkJobCodec) where++import Data.List.NonEmpty (NonEmpty (..))+import Keiro.Codec (Codec (..), EventType (..))+import Keiro.PGMQ.Codec (JobCodec, keiroJobCodec)+import Generated.MappedNominalQueueOnly.TemplateWork.Queue (TemplateWork, encodeTemplateWork, parseTemplateWork)++templateWorkPayloadCodec :: Codec TemplateWork+templateWorkPayloadCodec =+  Codec+    { eventTypes = EventType "TemplateWork" :| []+    , eventType = \_ -> EventType "TemplateWork"+    , schemaVersion = 1+    , encode = encodeTemplateWork+    , decode = \_ -> parseTemplateWork+    , upcasters = []+    }++templateWorkJobCodec :: JobCodec TemplateWork+templateWorkJobCodec = keiroJobCodec templateWorkPayloadCodec
+ test/conformance-nominal-queue-only/Generated/MappedNominalQueueOnly/TemplateWork/QueuePolicy.hs view
@@ -0,0 +1,43 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from workqueue template_work; do not edit.+module Generated.MappedNominalQueueOnly.TemplateWork.QueuePolicy+  ( TemplateWorkOutcome (..)+  , retryPolicy, jobOutcomeFor+  , jobOrdering, jobTuningFor, queueProvision+  ) where++import Keiro.PGMQ.Job (JobOrdering (..), JobOutcome (..), JobTuning, QueueProvision, RetryDelay (..), RetryPolicy (..), standardProvision, withOrdering)++jobOrdering :: JobOrdering+jobOrdering = Unordered++-- Deployment owns a positive batch size, visibility timeout, and polling; the spec owns ordering. Legacy FIFO modes reject batch sizes greater than one.+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 = standardProvision++retryPolicy :: RetryPolicy+retryPolicy =+  RetryPolicy+    { maxRetries = 3+    , defaultRetryDelay = RetryDelay 1+    , useDeadLetter = True+    }++-- The consumer JobOutcome disposition over the spec's named domain outcomes,+-- lowered to the live Keiro.PGMQ.Job.JobOutcome.+data TemplateWorkOutcome+  = StoreFailure+  | CommandRejected+  | DecodeFailure+  | OnCodecReject+  deriving stock (Eq, Show)++jobOutcomeFor :: TemplateWorkOutcome -> JobOutcome+jobOutcomeFor o = case o of+  StoreFailure -> Retry (RetryDelay 1)+  CommandRejected -> Dead "dead-lettered"+  DecodeFailure -> Dead "dead-lettered"+  OnCodecReject -> Dead "dead-lettered"
+ test/conformance-nominal-queue-only/keiro-dsl-cabal-fragment.context.mapped-nominal-queue-only.txt view
@@ -0,0 +1,27 @@+-- keiro-dsl build manifest for keiro-dsl/test/fixtures/mapped-nominal-queue-only.keiro+-- Paste the complete fragment below into the consuming Cabal stanza.+-- The generated layer is overwritten on every scaffold; hole modules are+-- create-if-absent (filled by hand).++default-language: GHC2024+default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings++other-modules:+    Generated.MappedNominalQueueOnly.Nominals+    Generated.MappedNominalQueueOnly.Nominals.Internal+    Generated.MappedNominalQueueOnly.Structural.NominalLeaves+    Generated.MappedNominalQueueOnly.StructuralConformance+    Generated.MappedNominalQueueOnly.TemplateWork.Queue+    Generated.MappedNominalQueueOnly.TemplateWork.QueueCodec+    Generated.MappedNominalQueueOnly.TemplateWork.QueuePolicy++build-depends:+    , aeson+    , base+    , keiro-core+    , keiro-pgmq+    , text
+ test/conformance-nominal-queue-only/keiro-dsl-ledger.context.mapped-nominal-queue-only.txt view
@@ -0,0 +1,24 @@+keiro-dsl scaffold record v1+spec: keiro-dsl/test/fixtures/mapped-nominal-queue-only.keiro+module-root: (none)+layout: prefixed+source-language {"declaredLanguageVersion":6,"effectiveLanguageVersion":6,"sourceForm":"declared"}+semantic-contract {"languageSupport":"candidate","languageVersion":6,"runtimeSemantics":"keiro-dsl/runtime-semantics/5"}+naming-edition idiomatic-v2+module-role {"family":"StructuralConformance","kind":"generated","ownerKind":"context","ownerName":"context mapped-nominal-queue-only structural conformance","path":"Generated/MappedNominalQueueOnly/StructuralConformance.hs"}+module-role {"family":"Nominals","kind":"generated","ownerKind":"context","ownerName":"context mapped-nominal-queue-only generated nominal declarations","path":"Generated/MappedNominalQueueOnly/Nominals.hs"}+module-role {"family":"Internal","kind":"generated","ownerKind":"context","ownerName":"context mapped-nominal-queue-only generated nominal ID internals","path":"Generated/MappedNominalQueueOnly/Nominals/Internal.hs"}+module-role {"family":"NominalLeaves","kind":"generated","ownerKind":"context","ownerName":"context mapped-nominal-queue-only structural nominal leaves","path":"Generated/MappedNominalQueueOnly/Structural/NominalLeaves.hs"}+module-role {"family":"Queue","kind":"generated","ownerKind":"workqueue","ownerName":"workqueue template_work (line 6)","path":"Generated/MappedNominalQueueOnly/TemplateWork/Queue.hs"}+module-role {"family":"QueuePolicy","kind":"generated","ownerKind":"workqueue","ownerName":"workqueue template_work (line 6)","path":"Generated/MappedNominalQueueOnly/TemplateWork/QueuePolicy.hs"}+module-role {"family":"QueueCodec","kind":"generated","ownerKind":"workqueue","ownerName":"workqueue template_work (line 6)","path":"Generated/MappedNominalQueueOnly/TemplateWork/QueueCodec.hs"}+generated Generated/MappedNominalQueueOnly/StructuralConformance.hs+generated Generated/MappedNominalQueueOnly/Nominals.hs+generated Generated/MappedNominalQueueOnly/Nominals/Internal.hs+generated Generated/MappedNominalQueueOnly/Structural/NominalLeaves.hs+generated Generated/MappedNominalQueueOnly/TemplateWork/Queue.hs+generated Generated/MappedNominalQueueOnly/TemplateWork/QueuePolicy.hs+generated Generated/MappedNominalQueueOnly/TemplateWork/QueueCodec.hs+id-domain id-domain|name=TemplateId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=template|separator=_|json=canonical-json-text+nominal-equality nominal-equality|name=TemplateId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:template:keiro-dsl/id-domain/typeid-v7/1|owner=generated+semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
test/conformance-nominal-scalars/Generated/NominalScalars/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context nominal-scalars behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context nominal-scalars behavior source map; do not edit. module Generated.NominalScalars.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-nominal-scalars/Generated/NominalScalars/Nominal/Shape/OrderStatus.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from bound nominal enum representation OrderStatus; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from bound nominal enum representation OrderStatus; do not edit. module Generated.NominalScalars.Nominal.Shape.OrderStatus (OrderStatusRepresentation (..), orderStatusRepresentationText) where  import Data.Text (Text)
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/BehaviorContract.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit. module Generated.NominalScalars.NominalLedger.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit. module Generated.NominalScalars.NominalLedger.Codec (     nominalLedgerCodec,     parseNominalLedgerEvent,
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Domain.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit. module Generated.NominalScalars.NominalLedger.Domain where  import Data.Aeson (FromJSON, ToJSON)
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit. module Generated.NominalScalars.NominalLedger.EventStream   ( nominalLedgerCategory   , nominalLedgerCommandCategory
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Harness.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedLabels #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit. module Generated.NominalScalars.NominalLedger.Harness (harnessAssertions) where  import Generated.NominalScalars.NominalLedger.Domain
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit. module Generated.NominalScalars.NominalLedger.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Transducer.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit. module Generated.NominalScalars.NominalLedger.Transducer   ( nominalLedgerTransducer   , nominalLedgerFoldFingerprint
test/conformance-nominal-scalars/Generated/NominalScalars/NominalProjections.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TypeFamilies #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context nominal-scalars nominal scalar projection facade; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context nominal-scalars nominal scalar projection facade; do not edit. module Generated.NominalScalars.NominalProjections where  import Data.KindID qualified as KindID@@ -7,7 +7,7 @@ import Data.Text (Text) import Data.Time (UTCTime) import Keiki.Core (FieldProjection (..), FieldWitness, ExactFieldProjection (..), exactFieldWitness, fieldWitness)-import Keiki.ProjectionDomain (TextPattern, finiteProjectionDomain, matchesTextPattern, textProjectionDomain)+import Keiki.ProjectionDomain (TextPattern, matchesTextPattern, textProjectionDomain, finiteProjectionDomain) import Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV7Domain, validateIdDomainText) import Keiro.Codec.Nominal (nominalToRepresentation, nominalFromRepresentation) import Numeric.Natural (Natural)
test/conformance-nominal-scalars/Generated/NominalScalars/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context nominal-scalars replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context nominal-scalars replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-process-full/Generated/SurgeDemo/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context surge-demo behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context surge-demo behavior source map; do not edit. module Generated.SurgeDemo.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-process-full/Generated/SurgeDemo/Hospital/BehaviorContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.SurgeDemo.Hospital.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-process-full/Generated/SurgeDemo/Hospital/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.SurgeDemo.Hospital.Codec (     hospitalCodec,     parseHospitalEvent,
test/conformance-process-full/Generated/SurgeDemo/Hospital/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.SurgeDemo.Hospital.Domain where  import GHC.Generics (Generic)
test/conformance-process-full/Generated/SurgeDemo/Hospital/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.SurgeDemo.Hospital.EventStream   ( hospitalCategory   , hospitalCommandCategory
test/conformance-process-full/Generated/SurgeDemo/Hospital/Harness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.SurgeDemo.Hospital.Harness (harnessAssertions) where  import Generated.SurgeDemo.Hospital.Domain
test/conformance-process-full/Generated/SurgeDemo/Hospital/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.SurgeDemo.Hospital.Projection   ( hospitalProjection   , hospitalStatusFor
test/conformance-process-full/Generated/SurgeDemo/Hospital/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.SurgeDemo.Hospital.Transducer   ( hospitalTransducer   , hospitalFoldFingerprint
test/conformance-process-full/Generated/SurgeDemo/Nominals.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context surge-demo generated nominal declarations; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context surge-demo generated nominal declarations; do not edit. module Generated.SurgeDemo.Nominals   ( HospitalId   , parseHospitalId
test/conformance-process-full/Generated/SurgeDemo/Nominals/Internal.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context surge-demo generated nominal ID internals; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context surge-demo generated nominal ID internals; do not edit. module Generated.SurgeDemo.Nominals.Internal   ( HospitalId   , parseHospitalId
test/conformance-process-full/Generated/SurgeDemo/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context surge-demo replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context surge-demo replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-process-full/Generated/SurgeDemo/Surge/BehaviorContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.SurgeDemo.Surge.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-process-full/Generated/SurgeDemo/Surge/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.SurgeDemo.Surge.Codec (     surgeCodec,     parseSurgeEvent,
test/conformance-process-full/Generated/SurgeDemo/Surge/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.SurgeDemo.Surge.Domain where  import GHC.Generics (Generic)
test/conformance-process-full/Generated/SurgeDemo/Surge/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.SurgeDemo.Surge.EventStream   ( surgeCategory   , surgeCommandCategory
test/conformance-process-full/Generated/SurgeDemo/Surge/Harness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.SurgeDemo.Surge.Harness (harnessAssertions) where  import Generated.SurgeDemo.Surge.Domain
test/conformance-process-full/Generated/SurgeDemo/Surge/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.SurgeDemo.Surge.Projection   ( surgeProjection   , surgeStatusFor
test/conformance-process-full/Generated/SurgeDemo/Surge/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.SurgeDemo.Surge.Transducer   ( surgeTransducer   , surgeFoldFingerprint
test/conformance-process-full/Generated/SurgeDemo/SurgeFlow/Process.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from process SurgeFlow; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from process SurgeFlow; do not edit. module Generated.SurgeDemo.SurgeFlow.Process   ( surgeFlowProcessName   , surgeFlowCategory
test/conformance-process-full/Generated/SurgeDemo/SurgeFlow/ProcessHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from process SurgeFlow; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from process SurgeFlow; do not edit. module Generated.SurgeDemo.SurgeFlow.ProcessHarness (processHarnessValues) where  -- | (label, value): the spec's deterministic process/timer decisions,
test/conformance-process-full/keiro-dsl-ledger.context.surge-demo.txt view
@@ -65,4 +65,5 @@ behavior {"aggregate":"Surge","command":"NoteSurgeThreshold","evidence":"generated-authoritative","key":"behavior-v1-9d1377f4e60cd45a","kind":"required-rejection","outputs":[],"source":"Fired"} behavior {"aggregate":"Surge","command":"NoteSurgeThreshold","evidence":"generated-authoritative","key":"behavior-v1-c7783d8bb46678fe","kind":"required-rejection","outputs":[],"source":"Noted"} behavior {"aggregate":"Surge","command":"MarkSurgeTimerFired","evidence":"generated-authoritative","key":"behavior-v1-db2fec76864e5867","kind":"live-transition","outputs":[{"command":"MarkSurgeTimerFired","ownership":"generated-command-identity"}],"source":"Noted"}+process-reaction {"fingerprint":null,"holeObligations":[],"processName":"surge-demo","verification":"custom-unverified","version":null} semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
+ test/conformance-process-reactions/Generated/ProcessReactions/AuditOnly/Input.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveAnyClass #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process input AuditOnly; do not edit.+module Generated.ProcessReactions.AuditOnly.Input (AuditOnlyInput (..)) where++import Data.Aeson (FromJSON, ToJSON)+import GHC.Generics (Generic)+import Generated.ProcessReactions.Nominals qualified as N++data AuditOnlyInput+  = IncidentNoted+      { incidentId :: !N.IncidentId+      }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromJSON, ToJSON)
+ test/conformance-process-reactions/Generated/ProcessReactions/AuditOnly/Process.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process reaction AuditOnly; do not edit.+module Generated.ProcessReactions.AuditOnly.Process+  ( AuditOnlyInput (..)+  , auditOnlyProcessName+  , auditOnlyCategory+  , auditOnlyProcessWorkerOptions+  , auditOnlyReactionVersion+  , auditOnlyReactionFingerprint+  , auditOnlyReact+  , auditOnlyProcessManager+  , auditOnlyRunProcessWorker+  ) where++import Data.Text (Text)+import Numeric.Natural (Natural)+import Generated.ProcessReactions.AuditOnly.Input (AuditOnlyInput (..))+import ProcessReactions.AuditOnly.ProcessHoles (decodeAuditOnlyInput)+import Generated.ProcessReactions.IncidentSaga.Domain qualified as Saga+import Generated.ProcessReactions.IncidentSaga.EventStream (incidentSagaEventStream, IncidentSagaEventStreamDef)+import Generated.ProcessReactions.Incident.Domain qualified as Target+import Generated.ProcessReactions.Incident.EventStream (incidentEventStream)+import Generated.ProcessReactions.Nominals qualified as N+import Keiro.Command (DomainCommandHandler (..), SilentDomainDecision (..))+import Keiro.ProcessManager.Reaction qualified as Reaction+import Keiro.Stream qualified as Stream+import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))+import Shibuya.Core.Ack (RetryDelay (..))++auditOnlyProcessName :: Text+auditOnlyProcessName = "audit-only"++auditOnlyCategory :: Stream.StreamCategory IncidentSagaEventStreamDef+auditOnlyCategory = Stream.categoryUnsafe "incidentAudit"++auditOnlyProcessWorkerOptions :: WorkerOptions es msg+auditOnlyProcessWorkerOptions =+  WorkerOptions+    { poisonPolicy = PoisonHalt,+      rejectedCommandPolicy = RejectedHalt,+      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning+      metrics = Nothing -- runtime configuration; install at call site+    }++auditOnlyReactionVersion :: Natural+auditOnlyReactionVersion = 1++auditOnlyReactionFingerprint :: Text+auditOnlyReactionFingerprint = "a98c341339b007c1e28edff6a1a89b91a9dd3ac63c83bfe57e6b41479d84af96"++auditOnlyCorrelate :: AuditOnlyInput -> Text+auditOnlyCorrelate input = case input of+  IncidentNoted { incidentId } -> (N.incidentIdText incidentId)++auditOnlyReact :: AuditOnlyInput -> Reaction.ReactionPlan Saga.IncidentSagaCommand Target.IncidentCommand+auditOnlyReact input = case input of+  IncidentNoted {}+    -> Reaction.NoAdvance []++auditOnlyProcessManager =+  Reaction.ReactiveProcessManager+    { name = auditOnlyProcessName+    , correlate = auditOnlyCorrelate+    , sagaHandler = DomainCommandHandler { eventStream = incidentSagaEventStream, classifySilent = \_ -> SilentNoOp () }+    , streamFor = Stream.entityStream auditOnlyCategory+    , targetEventStream = incidentEventStream+    , targetProjections = const []+    , react = auditOnlyReact+    }++auditOnlyRunProcessWorker options adapter =+  Reaction.runReactiveProcessManagerWorkerWith+    auditOnlyProcessWorkerOptions+    options+    auditOnlyProcessManager+    adapter+    (\event -> case decodeAuditOnlyInput event of Nothing -> Nothing; Just input -> Just (event, input))
+ test/conformance-process-reactions/Generated/ProcessReactions/AuditOnly/ProcessHarness.hs view
@@ -0,0 +1,16 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process AuditOnly; do not edit.+module Generated.ProcessReactions.AuditOnly.ProcessHarness (processHarnessValues) where++-- | (label, value): the spec's deterministic process/timer decisions,+-- lowered to plain values so a driver can assert them against a committed+-- expectation. The driver's expectation is hand-written (not generated), so a+-- spec change that alters a decision diverges from it and turns a specific+-- assertion red — the spec->behaviour pin. (Live-runtime behavioural+-- conformance of the filled ProcessManager is the M5 step.)+processHarnessValues :: [(String, String)]+processHarnessValues =+  [ ("reactionOwnership", "generated-declarative")+  , ("reactionVersion", "1")+  , ("reactionFingerprint", "a98c341339b007c1e28edff6a1a89b91a9dd3ac63c83bfe57e6b41479d84af96")+  , ("reaction.IncidentNoted.0", "guard=always;advance=none;followUps=;accepted=")+  ]
+ test/conformance-process-reactions/Generated/ProcessReactions/BehaviorSourceMap.hs view
@@ -0,0 +1,31 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context process-reactions behavior source map; do not edit.+module Generated.ProcessReactions.BehaviorSourceMap+  ( BehaviorSourceLocation (..)+  , behaviorSourceLocation+  , renderBehaviorSourceLocation+  ) where++import Data.Text (Text)+import Data.Text qualified as T++data BehaviorSourceLocation = BehaviorSourceLocation+  { file :: !FilePath+  , line :: !Int+  , column :: !Int+  }+  deriving stock (Eq, Ord, Show)++behaviorSourceLocation :: Text -> Maybe BehaviorSourceLocation+behaviorSourceLocation key = case key of+  "behavior-v1-4126b087f05aadf6" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-reactions.keiro" 769 3)+  "behavior-v1-6b66722f9f2463d3" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-reactions.keiro" 761 3)+  "behavior-v1-825e6c1709cb63b4" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-reactions.keiro" 762 3)+  _ -> Nothing++renderBehaviorSourceLocation :: Text -> Text+renderBehaviorSourceLocation key = case behaviorSourceLocation key of+  Just location -> T.pack location.file <> ":" <> tshow location.line <> ":" <> tshow location.column+  Nothing -> "<internal invariant: missing behavior source for " <> key <> ">"++tshow :: Show value => value -> Text+tshow = T.pack . show
+ test/conformance-process-reactions/Generated/ProcessReactions/Incident/BehaviorContract.hs view
@@ -0,0 +1,337 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessReactions.Incident.BehaviorContract+  ( BehaviorKey (..)+  , unBehaviorKey+  , ObligationKind (..)+  , EvidenceLevel (..)+  , GuardCoverage (..)+  , BehaviorRequirement (..)+  , RejectionClass (..)+  , LiveExpectation (..)+  , BehaviorWitness (..)+  , BehaviorFailure (..)+  , BehaviorConformanceReport (..)+  , behaviorRequirements+  , behaviorCoverageReport+  , behaviorConformancePassed+  , behaviorConformancePassedWith+  , renderBehaviorConformanceText+  ) where++import Generated.ProcessReactions.Incident.Codec (encodeIncidentEvent, parseIncidentEvent, incidentCodec)+import Generated.ProcessReactions.Incident.Domain+import Generated.ProcessReactions.Incident.Transducer (incidentTransducer)+import Generated.ProcessReactions.BehaviorSourceMap qualified as BehaviorSourceMap+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 (EdgeMode (..), EdgeRef (..), RegFile, ReplayAttribution (..), ReplayEventSpan (..), ReplaySuccess (..), StepFailure (..), StepSuccess (..), applyEventsDetailedEither, stepDetailedEither)+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+  { key :: !BehaviorKey+  , kind :: !ObligationKind+  , evidence :: !EvidenceLevel+  , guardCoverage :: !GuardCoverage+  , source :: !IncidentVertex+  , commandName :: !Text+  , expectedEdge :: !(Maybe (K.EdgeRef IncidentVertex))+  , target :: !(Maybe IncidentVertex)+  , eventKinds :: ![Text]+  }+  deriving stock (Eq, Show)++data RejectionClass = RejectNoOutgoingEdges | RejectNoMatchingEdge+  deriving stock (Eq, Show)++data LiveExpectation+  = Emits (NonEmpty IncidentEvent)+  | Rejects RejectionClass+  | NoOp+  deriving stock (Eq, Show)++data BehaviorWitness+  = Pending BehaviorKey+  | LiveWitness+      { key :: BehaviorKey+      , history :: [IncidentEvent]+      , command :: IncidentCommand+      , expected :: LiveExpectation+      }+  | ReplayWitness+      { key :: BehaviorKey+      , historyPrefix :: [IncidentEvent]+      , observedChunk :: [IncidentEvent]+      }+  deriving stock (Eq, Show)++data BehaviorFailure = BehaviorFailure+  { key :: !BehaviorKey+  , subject :: !Text+  , code :: !Text+  , detail :: !Text+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorFailure where+  toJSON behaviorFailure = object+    [ "key" .= unBehaviorKey behaviorFailure.key+    , "subject" .= behaviorFailure.subject+    , "code" .= behaviorFailure.code+    , "detail" .= behaviorFailure.detail+    ]++data BehaviorConformanceReport = BehaviorConformanceReport+  { required :: ![BehaviorKey]+  , filled :: ![BehaviorKey]+  , pending :: ![BehaviorKey]+  , missing :: ![BehaviorKey]+  , duplicate :: ![BehaviorKey]+  , stale :: ![BehaviorKey]+  , failed :: ![BehaviorFailure]+  , verified :: ![BehaviorKey]+  , unverified :: ![BehaviorKey]+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorConformanceReport where+  toJSON report = object+    [ "schema" .= ("keiro/behavior-conformance/1" :: Text)+    , "required" .= keyTexts report.required+    , "filled" .= keyTexts report.filled+    , "pending" .= keyTexts report.pending+    , "missing" .= keyTexts report.missing+    , "duplicate" .= keyTexts report.duplicate+    , "stale" .= keyTexts report.stale+    , "failed" .= report.failed+    , "verified" .= keyTexts report.verified+    , "unverified" .= keyTexts report.unverified+    ]++behaviorRequirements :: [BehaviorRequirement]+behaviorRequirements =+  [ -- IncidentOpen x EscalateIncident: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-4126b087f05aadf6"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = IncidentOpen+      , commandName = "EscalateIncident"+      , expectedEdge = (Just (K.EdgeRef IncidentOpen 0))+      , target = Just IncidentOpen+      , eventKinds = ["IncidentEscalated"]+      }+  ]++behaviorCoverageReport :: [BehaviorWitness] -> BehaviorConformanceReport+behaviorCoverageReport witnesses =+  BehaviorConformanceReport+    { required = sortedKeys (Map.keys requiredByKey)+    , filled = sortedKeys [key | (key, [witness]) <- Map.toList witnessGroups, Map.member key requiredByKey, not (isPending witness)]+    , pending = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, Map.member key requiredByKey, any isPending rows]+    , missing = sortedKeys [key | key <- Map.keys requiredByKey, Map.notMember key witnessGroups]+    , duplicate = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, length rows > 1]+    , stale = sortedKeys [key | key <- Map.keys witnessGroups, Map.notMember key requiredByKey]+    , failed = sortOn (unBehaviorKey . (.key)) failures+    , verified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, proofStrength requirement]+    , unverified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, not (proofStrength requirement)]+    }+ where+  requiredByKey = Map.fromList [(requirement.key, 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.pending+    && null report.missing+    && null report.duplicate+    && null report.stale+    && null report.failed+    && (not failOnUnverified || null report.unverified)++renderBehaviorConformanceText :: BehaviorConformanceReport -> Text+renderBehaviorConformanceText report = T.unlines+  [ "behavior conformance: Incident"+  , "schema: keiro/behavior-conformance/1"+  , countLine "required" report.required+  , countLine "filled" report.filled+  , countLine "pending" report.pending+  , countLine "missing" report.missing+  , countLine "duplicate" report.duplicate+  , countLine "stale" report.stale+  , "failed: " <> tshow (length report.failed)+  , countLine "verified" report.verified+  , countLine "unverified" report.unverified+  ] <> T.unlines ["FAIL " <> unBehaviorKey behaviorFailure.key <> " " <> behaviorFailure.subject <> " [" <> behaviorFailure.code <> "] " <> behaviorFailure.detail | behaviorFailure <- report.failed]++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 -> [IncidentEvent] -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runLive requirement history command expectation = do+  settled <- settleHistory requirement "history" history+  ensure requirement (K.replaySuccessState settled == requirement.source) "history-wrong-source" "history does not settle at the required source vertex"+  ensure requirement (commandKind command == requirement.commandName) "command-mismatch" "witness command constructor does not match the required state/command cell"+  case requirement.kind 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 -> (IncidentVertex, K.RegFile IncidentRegs) -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runRejection requirement seed command expectation = case expectation of+  Emits _ -> failure requirement "expectation-kind" "a rejection requirement cannot expect emitted events"+  NoOp -> failure requirement "expectation-kind" "a rejection requirement cannot expect an accepted no-op"+  Rejects expectedClass -> case K.stepDetailedEither incidentTransducer 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 -> (IncidentVertex, K.RegFile IncidentRegs) -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runAcceptance requirement seed command expectation = case expectation of+  Rejects _ -> failure requirement "expectation-kind" "a live-transition requirement needs Emits or NoOp"+  NoOp -> case K.stepDetailedEither incidentTransducer 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"+  Emits expectedEvents -> case K.stepDetailedEither incidentTransducer 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.eventKinds) "event-envelope-mismatch" ("runtime event kinds differ from the declared ordered envelope; actual=" <> tshow (map eventKind actual) <> " expected=" <> tshow requirement.eventKinds)+      decoded <- either (failure requirement "emitted-codec-decode") Right (decodeEvents actual)+      replayed <- case K.applyEventsDetailedEither incidentTransducer 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)++checkAcceptedEnvelope :: BehaviorRequirement -> K.StepSuccess IncidentRegs IncidentVertex IncidentEvent -> 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.expectedEdge) "edge-attribution" ("runtime selected a different guarded sibling; actual=" <> tshow (Just (K.stepSuccessEdge success)) <> " expected=" <> tshow requirement.expectedEdge)+  ensure requirement (Just (K.stepSuccessState success) == requirement.target) "target-mismatch" ("runtime reached a different target vertex; actual=" <> tshow (Just (K.stepSuccessState success)) <> " expected=" <> tshow requirement.target)++runReplay :: BehaviorRequirement -> [IncidentEvent] -> [IncidentEvent] -> Either BehaviorFailure ()+runReplay requirement prefix chunk = case requirement.kind of+  ReplayTransition -> do+    settled <- settleHistory requirement "history-prefix" prefix+    ensure requirement (K.replaySuccessState settled == requirement.source) "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 incidentTransducer (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.target) "target-mismatch" ("replay chunk reached a different target vertex; actual=" <> tshow (Just (K.replaySuccessState replayed)) <> " expected=" <> tshow requirement.target)+    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 IncidentVertex] -> Either BehaviorFailure ()+checkSingleAttribution requirement expectedMode eventCount trace = case trace of+  [attribution] -> do+    ensure requirement (Just (K.replayAttributionEdge attribution) == requirement.expectedEdge) "replay-edge-attribution" ("replay selected a different edge; actual=" <> tshow (Just (K.replayAttributionEdge attribution)) <> " expected=" <> tshow requirement.expectedEdge)+    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.source) "replay-source-attribution" ("replay attribution starts at the wrong source; actual=" <> tshow (K.replayAttributionSource attribution) <> " expected=" <> tshow requirement.source)+    ensure requirement (Just (K.replayAttributionTarget attribution) == requirement.target) "replay-target-attribution" ("replay attribution ends at the wrong target; actual=" <> tshow (Just (K.replayAttributionTarget attribution)) <> " expected=" <> tshow requirement.target)+    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 -> [IncidentEvent] -> Either BehaviorFailure (K.ReplaySuccess IncidentRegs IncidentVertex)+settleHistory requirement label history = do+  decoded <- either (failure requirement (label <> "-codec-decode")) Right (decodeEvents history)+  case K.applyEventsDetailedEither incidentTransducer (IncidentOpen, initialIncidentRegs) decoded of+    Left replayFailure -> failure requirement (label <> "-replay-failed") (tshow replayFailure)+    Right replaySuccess -> Right replaySuccess++decodeEvents :: [IncidentEvent] -> Either Text [IncidentEvent]+decodeEvents = traverse (\event -> parseIncidentEvent (Codec.eventType incidentCodec event) (encodeIncidentEvent event))++commandKind :: IncidentCommand -> Text+commandKind command = case command of+  EscalateIncident _ -> "EscalateIncident"++eventKind :: IncidentEvent -> Text+eventKind event = case Codec.eventType incidentCodec event of Codec.EventType tag -> tag++regsEqual :: K.RegFile IncidentRegs -> K.RegFile IncidentRegs -> Bool+regsEqual _ _ = True++proofStrength :: BehaviorRequirement -> Bool+proofStrength requirement =+  requirement.evidence == GeneratedAuthoritative+    && requirement.guardCoverage `elem` [GuardTotal, GuardNotApplicable]++behaviorWitnessKey :: BehaviorWitness -> BehaviorKey+behaviorWitnessKey witness = case witness of+  Pending key -> key+  LiveWitness { key = key } -> key+  ReplayWitness { key = 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.key+        (tshow requirement.source <> " x " <> requirement.commandName <> ": " <> kindPhrase <> " (" <> BehaviorSourceMap.renderBehaviorSourceLocation (unBehaviorKey requirement.key) <> ")")+        code+        detail+    )+ where+  kindPhrase = case requirement.kind 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
+ test/conformance-process-reactions/Generated/ProcessReactions/Incident/Codec.hs view
@@ -0,0 +1,66 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessReactions.Incident.Codec (+    incidentCodec,+    parseIncidentEvent,+    encodeIncidentEvent,+) where++import Generated.ProcessReactions.Incident.Domain+import Generated.ProcessReactions.Nominals (incidentIdText)+import Generated.ProcessReactions.Nominals.Internal (unsafeIncidentIdFromLegacyText)+import Data.Aeson (Value, object, withObject, (.:), (.=))+import Data.Aeson.Types (parseEither)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text (Text)+import qualified Data.Text as T+import Keiro.Codec (Codec (..), EventType (..))++++++incidentEventTypes :: NonEmpty EventType+incidentEventTypes = EventType "IncidentEscalated" :| []++incidentCodec :: Codec IncidentEvent+incidentCodec =+  Codec+    { eventTypes = incidentEventTypes+    , eventType = \case+        IncidentEscalated{} -> EventType "IncidentEscalated"+    , schemaVersion = 1+    , encode = encodeIncidentEvent+    , decode = parseIncidentEvent+    , upcasters = []+    }++encodeIncidentEvent :: IncidentEvent -> Value+encodeIncidentEvent = \case+  IncidentEscalated payload ->+    object+      [ "kind" .= ("IncidentEscalated" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]++parseIncidentEvent :: EventType -> Value -> Either Text IncidentEvent+parseIncidentEvent (EventType tag) = mapLeftText . parseEither (withObject "IncidentEvent" go)+  where+    go o = do+      case tag of+        "IncidentEscalated" ->+          IncidentEscalated+            <$> ( IncidentEscalatedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes incidentEventTypes)++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
+ test/conformance-process-reactions/Generated/ProcessReactions/Incident/Domain.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessReactions.Incident.Domain where++import GHC.Generics (Generic)+import Keiki.Core (RegFile (..))+import Generated.ProcessReactions.Nominals (IncidentId)+import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)++data IncidentVertex = IncidentOpen+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)++data EscalateIncidentData = EscalateIncidentData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentCommand = EscalateIncident !EscalateIncidentData+  deriving stock (Generic, Eq, Show)++data IncidentEscalatedData = IncidentEscalatedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentEvent = IncidentEscalated !IncidentEscalatedData+  deriving stock (Generic, Eq, Show)++type IncidentRegs =+  '[]++initialIncidentRegs :: RegFile IncidentRegs+initialIncidentRegs =+  RNil++$(deriveAggregateCtorsAll ''IncidentCommand ''IncidentRegs)++++$(deriveWireCtorsAll ''IncidentEvent)
+ test/conformance-process-reactions/Generated/ProcessReactions/Incident/EventStream.hs view
@@ -0,0 +1,49 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessReactions.Incident.EventStream+  ( incidentCategory+  , incidentCommandCategory+  , incidentEventStream+  , incidentEventStreamDef+  , IncidentEventStream+  , IncidentEventStreamDef+  ) where++import Generated.ProcessReactions.Incident.Domain+import Generated.ProcessReactions.Incident.Codec (incidentCodec)+import Generated.ProcessReactions.Incident.Transducer (incidentTransducer)+import Keiki.Core (HsPred)+import Keiro.EventStream (EventStream (..), SnapshotPolicy (..))+import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow)+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.+incidentCategory :: Stream.StreamCategory IncidentEventStreamDef+incidentCategory = Stream.categoryUnsafe "incident"++-- The same category text, typed for command envelopes such as PMCommand.+incidentCommandCategory :: Stream.StreamCategory IncidentCommand+incidentCommandCategory = Stream.categoryUnsafe "incident"++type IncidentEventStreamDef =+  EventStream (HsPred IncidentRegs IncidentCommand) IncidentRegs IncidentVertex IncidentCommand IncidentEvent++type IncidentEventStream =+  ValidatedEventStream (HsPred IncidentRegs IncidentCommand) IncidentRegs IncidentVertex IncidentCommand IncidentEvent++incidentEventStreamDef :: IncidentEventStreamDef+incidentEventStreamDef =+  EventStream+    { transducer = incidentTransducer,+      initialState = IncidentOpen,+      initialRegisters = initialIncidentRegs,+      eventCodec = incidentCodec,+      resolveStreamName = Stream.streamName,+      snapshotPolicy = Never,+      stateCodec = Nothing+    }++incidentEventStream :: IncidentEventStream+incidentEventStream =+  mkEventStreamOrThrow "Incident" incidentEventStreamDef
+ test/conformance-process-reactions/Generated/ProcessReactions/Incident/Harness.hs view
@@ -0,0 +1,57 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessReactions.Incident.Harness (harnessAssertions) where++import Generated.ProcessReactions.Incident.Domain+import Generated.ProcessReactions.Incident.Codec (encodeIncidentEvent, parseIncidentEvent, incidentCodec)+import Generated.ProcessReactions.Incident.Transducer (incidentTransducer)+import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)+import Keiro.Codec (eventType)+import Generated.ProcessReactions.Nominals (IncidentId, parseIncidentId)++-- | (label, passed). A driver runs these and exits non-zero on any False,+-- naming the failing assertion. Filling a hole wrongly turns a specific+-- entry False; the scaffold cannot.+harnessAssertions :: [(String, Bool)]+harnessAssertions =+  [ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions incidentTransducer))+  -- clock-free: spec samples no wall clock (verified at scaffold time)+  , ("golden round-trip: IncidentEscalated", roundTrips sampleEventIncidentEscalated)+  , ("accepts EscalateIncident from IncidentOpen", acceptEscalateIncident)+  ]+  ++ forwardReplayEscalateIncident++roundTrips :: IncidentEvent -> Bool+roundTrips e = parseIncidentEvent (eventType incidentCodec e) (encodeIncidentEvent e) == Right e++sampleIncidentId :: IncidentId+sampleIncidentId =+  case parseIncidentId "inc_01h455vb4pex5vsknk084sn02q" of+    Right parsed -> parsed+    Left problem -> error (show problem)++sampleEventIncidentEscalated :: IncidentEvent+sampleEventIncidentEscalated = IncidentEscalated (IncidentEscalatedData sampleIncidentId)++acceptEscalateIncident :: Bool+acceptEscalateIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (EscalateIncident (EscalateIncidentData sampleIncidentId)) of+    Just (v, _, _) -> v == IncidentOpen+    Nothing -> False++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayEscalateIncident :: [(String, Bool)]+forwardReplayEscalateIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (EscalateIncident (EscalateIncidentData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseIncidentEvent (eventType incidentCodec event) (encodeIncidentEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither incidentTransducer (IncidentOpen, initialIncidentRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: EscalateIncident from IncidentOpen -- "
+ test/conformance-process-reactions/Generated/ProcessReactions/Incident/Projection.hs view
@@ -0,0 +1,4 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessReactions.Incident.Projection () where++-- No projection declarations are present; this module keeps the generated manifest inventory total.
+ test/conformance-process-reactions/Generated/ProcessReactions/Incident/Transducer.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE QualifiedDo #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessReactions.Incident.Transducer+  ( incidentTransducer+  , incidentFoldFingerprint+  , BehaviorOwnership (..)+  , incidentPredicateVerifications+  ) where++import Generated.ProcessReactions.Incident.Domain+import Data.Text (Text)+import Keiki.Builder qualified as B+import Keiki.Core (HsPred, SymTransducer)+import Keiki.Core qualified as K+import Keiki.Symbolic qualified as S++incidentTransducer+  :: SymTransducer+       (HsPred IncidentRegs IncidentCommand)+       IncidentRegs+       IncidentVertex+       IncidentCommand+       IncidentEvent+incidentTransducer =+  B.buildTransducer IncidentOpen initialIncidentRegs isTerminal do+    B.from IncidentOpen do+      B.onCmd inCtorEscalateIncident $ \d -> B.do+        B.emit wireIncidentEscalated (IncidentEscalatedTermFields+          { incidentId = d.incidentId+          })+        B.goto IncidentOpen+ where+  isTerminal = \case++    _ -> False++incidentFoldFingerprint :: Text+incidentFoldFingerprint = "c556a3e2d4cd5877451be65f50921093"++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.+incidentPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]+incidentPredicateVerifications = sequence+  [ verifyTransition "transition1OpenEscalateIncident" GeneratedOwned IncidentOpen 0+  ]+ where+  verifyTransition label owner source edgeIndex =+    case drop edgeIndex (K.edgesOut incidentTransducer source) of+      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate+      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentReaction/Input.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE DeriveAnyClass #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process input IncidentReaction; do not edit.+module Generated.ProcessReactions.IncidentReaction.Input (IncidentReactionInput (..)) where++import Data.Aeson (FromJSON, ToJSON)+import GHC.Generics (Generic)+import Generated.ProcessReactions.Nominals qualified as N++data IncidentReactionInput+  = IncidentReported+      { incidentId :: !N.IncidentId+      , severity :: !N.Severity+      }+  | IncidentNoted+      { incidentId :: !N.IncidentId+      }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromJSON, ToJSON)
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentReaction/Process.hs view
@@ -0,0 +1,82 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process reaction IncidentReaction; do not edit.+module Generated.ProcessReactions.IncidentReaction.Process+  ( IncidentReactionInput (..)+  , incidentReactionProcessName+  , incidentReactionCategory+  , incidentReactionProcessWorkerOptions+  , incidentReactionReactionVersion+  , incidentReactionReactionFingerprint+  , incidentReactionReact+  , incidentReactionProcessManager+  , incidentReactionRunProcessWorker+  ) where++import Data.Text (Text)+import Numeric.Natural (Natural)+import Generated.ProcessReactions.IncidentReaction.Input (IncidentReactionInput (..))+import ProcessReactions.IncidentReaction.ProcessHoles (decodeIncidentReactionInput)+import Generated.ProcessReactions.IncidentSaga.Domain qualified as Saga+import Generated.ProcessReactions.IncidentSaga.EventStream (incidentSagaEventStream, IncidentSagaEventStreamDef)+import Generated.ProcessReactions.Incident.Domain qualified as Target+import Generated.ProcessReactions.Incident.EventStream (incidentCommandCategory, incidentEventStream)+import Generated.ProcessReactions.Nominals qualified as N+import Keiro.Command (DomainCommandHandler (..), SilentDomainDecision (..))+import Keiro.ProcessManager (PMCommand (..))+import Keiro.ProcessManager.Reaction qualified as Reaction+import Keiro.Stream qualified as Stream+import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))+import Shibuya.Core.Ack (RetryDelay (..))++incidentReactionProcessName :: Text+incidentReactionProcessName = "incident-reaction"++incidentReactionCategory :: Stream.StreamCategory IncidentSagaEventStreamDef+incidentReactionCategory = Stream.categoryUnsafe "incidentSaga"++incidentReactionProcessWorkerOptions :: WorkerOptions es msg+incidentReactionProcessWorkerOptions =+  WorkerOptions+    { poisonPolicy = PoisonHalt,+      rejectedCommandPolicy = RejectedHalt,+      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning+      metrics = Nothing -- runtime configuration; install at call site+    }++incidentReactionReactionVersion :: Natural+incidentReactionReactionVersion = 1++incidentReactionReactionFingerprint :: Text+incidentReactionReactionFingerprint = "dff4a685084373ac102b8fa9591bc4cdbaa358a19bdec488ea157bd038421573"++incidentReactionCorrelate :: IncidentReactionInput -> Text+incidentReactionCorrelate input = case input of+  IncidentReported { incidentId } -> (N.incidentIdText incidentId)+  IncidentNoted { incidentId } -> (N.incidentIdText incidentId)++incidentReactionReact :: IncidentReactionInput -> Reaction.ReactionPlan Saga.IncidentSagaCommand Target.IncidentCommand+incidentReactionReact input = case input of+  IncidentReported { incidentId, severity }+    | (severity == N.Sev1) -> Reaction.AdvanceReaction { command = Saga.RecordCritical (Saga.RecordCriticalData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId })))], onAccepted = [] }+    | otherwise -> Reaction.AdvanceReaction { command = Saga.RecordRoutine (Saga.RecordRoutineData { Saga.incidentId = incidentId }), followUps = [], onAccepted = [] }+  IncidentNoted {}+    -> Reaction.NoAdvance []++incidentReactionProcessManager =+  Reaction.ReactiveProcessManager+    { name = incidentReactionProcessName+    , correlate = incidentReactionCorrelate+    , sagaHandler = DomainCommandHandler { eventStream = incidentSagaEventStream, classifySilent = \_ -> SilentNoOp () }+    , streamFor = Stream.entityStream incidentReactionCategory+    , targetEventStream = incidentEventStream+    , targetProjections = const []+    , react = incidentReactionReact+    }++incidentReactionRunProcessWorker options adapter =+  Reaction.runReactiveProcessManagerWorkerWith+    incidentReactionProcessWorkerOptions+    options+    incidentReactionProcessManager+    adapter+    (\event -> case decodeIncidentReactionInput event of Nothing -> Nothing; Just input -> Just (event, input))
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentReaction/ProcessHarness.hs view
@@ -0,0 +1,18 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process IncidentReaction; do not edit.+module Generated.ProcessReactions.IncidentReaction.ProcessHarness (processHarnessValues) where++-- | (label, value): the spec's deterministic process/timer decisions,+-- lowered to plain values so a driver can assert them against a committed+-- expectation. The driver's expectation is hand-written (not generated), so a+-- spec change that alters a decision diverges from it and turns a specific+-- assertion red — the spec->behaviour pin. (Live-runtime behavioural+-- conformance of the filled ProcessManager is the M5 step.)+processHarnessValues :: [(String, String)]+processHarnessValues =+  [ ("reactionOwnership", "generated-declarative")+  , ("reactionVersion", "1")+  , ("reactionFingerprint", "dff4a685084373ac102b8fa9591bc4cdbaa358a19bdec488ea157bd038421573")+  , ("reaction.IncidentReported.0", "guard=input.severity == Severity.Sev1;advance=RecordCritical;followUps=dispatch:Incident.EscalateIncident;accepted=")+  , ("reaction.IncidentReported.1", "guard=otherwise;advance=RecordRoutine;followUps=;accepted=")+  , ("reaction.IncidentNoted.0", "guard=always;advance=none;followUps=;accepted=")+  ]
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/BehaviorContract.hs view
@@ -0,0 +1,350 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessReactions.IncidentSaga.BehaviorContract+  ( BehaviorKey (..)+  , unBehaviorKey+  , ObligationKind (..)+  , EvidenceLevel (..)+  , GuardCoverage (..)+  , BehaviorRequirement (..)+  , RejectionClass (..)+  , LiveExpectation (..)+  , BehaviorWitness (..)+  , BehaviorFailure (..)+  , BehaviorConformanceReport (..)+  , behaviorRequirements+  , behaviorCoverageReport+  , behaviorConformancePassed+  , behaviorConformancePassedWith+  , renderBehaviorConformanceText+  ) where++import Generated.ProcessReactions.IncidentSaga.Codec (encodeIncidentSagaEvent, parseIncidentSagaEvent, incidentSagaCodec)+import Generated.ProcessReactions.IncidentSaga.Domain+import Generated.ProcessReactions.IncidentSaga.Transducer (incidentSagaTransducer)+import Generated.ProcessReactions.BehaviorSourceMap qualified as BehaviorSourceMap+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 (EdgeMode (..), EdgeRef (..), RegFile, ReplayAttribution (..), ReplayEventSpan (..), ReplaySuccess (..), StepFailure (..), StepSuccess (..), applyEventsDetailedEither, stepDetailedEither)+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+  { key :: !BehaviorKey+  , kind :: !ObligationKind+  , evidence :: !EvidenceLevel+  , guardCoverage :: !GuardCoverage+  , source :: !IncidentSagaVertex+  , commandName :: !Text+  , expectedEdge :: !(Maybe (K.EdgeRef IncidentSagaVertex))+  , target :: !(Maybe IncidentSagaVertex)+  , eventKinds :: ![Text]+  }+  deriving stock (Eq, Show)++data RejectionClass = RejectNoOutgoingEdges | RejectNoMatchingEdge+  deriving stock (Eq, Show)++data LiveExpectation+  = Emits (NonEmpty IncidentSagaEvent)+  | Rejects RejectionClass+  | NoOp+  deriving stock (Eq, Show)++data BehaviorWitness+  = Pending BehaviorKey+  | LiveWitness+      { key :: BehaviorKey+      , history :: [IncidentSagaEvent]+      , command :: IncidentSagaCommand+      , expected :: LiveExpectation+      }+  | ReplayWitness+      { key :: BehaviorKey+      , historyPrefix :: [IncidentSagaEvent]+      , observedChunk :: [IncidentSagaEvent]+      }+  deriving stock (Eq, Show)++data BehaviorFailure = BehaviorFailure+  { key :: !BehaviorKey+  , subject :: !Text+  , code :: !Text+  , detail :: !Text+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorFailure where+  toJSON behaviorFailure = object+    [ "key" .= unBehaviorKey behaviorFailure.key+    , "subject" .= behaviorFailure.subject+    , "code" .= behaviorFailure.code+    , "detail" .= behaviorFailure.detail+    ]++data BehaviorConformanceReport = BehaviorConformanceReport+  { required :: ![BehaviorKey]+  , filled :: ![BehaviorKey]+  , pending :: ![BehaviorKey]+  , missing :: ![BehaviorKey]+  , duplicate :: ![BehaviorKey]+  , stale :: ![BehaviorKey]+  , failed :: ![BehaviorFailure]+  , verified :: ![BehaviorKey]+  , unverified :: ![BehaviorKey]+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorConformanceReport where+  toJSON report = object+    [ "schema" .= ("keiro/behavior-conformance/1" :: Text)+    , "required" .= keyTexts report.required+    , "filled" .= keyTexts report.filled+    , "pending" .= keyTexts report.pending+    , "missing" .= keyTexts report.missing+    , "duplicate" .= keyTexts report.duplicate+    , "stale" .= keyTexts report.stale+    , "failed" .= report.failed+    , "verified" .= keyTexts report.verified+    , "unverified" .= keyTexts report.unverified+    ]++behaviorRequirements :: [BehaviorRequirement]+behaviorRequirements =+  [ -- IncidentSagaOpen x RecordCritical: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-6b66722f9f2463d3"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = IncidentSagaOpen+      , commandName = "RecordCritical"+      , expectedEdge = (Just (K.EdgeRef IncidentSagaOpen 0))+      , target = Just IncidentSagaOpen+      , eventKinds = ["CriticalRecorded"]+      }+  , -- IncidentSagaOpen x RecordRoutine: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-825e6c1709cb63b4"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = IncidentSagaOpen+      , commandName = "RecordRoutine"+      , expectedEdge = (Just (K.EdgeRef IncidentSagaOpen 1))+      , target = Just IncidentSagaOpen+      , eventKinds = ["RoutineRecorded"]+      }+  ]++behaviorCoverageReport :: [BehaviorWitness] -> BehaviorConformanceReport+behaviorCoverageReport witnesses =+  BehaviorConformanceReport+    { required = sortedKeys (Map.keys requiredByKey)+    , filled = sortedKeys [key | (key, [witness]) <- Map.toList witnessGroups, Map.member key requiredByKey, not (isPending witness)]+    , pending = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, Map.member key requiredByKey, any isPending rows]+    , missing = sortedKeys [key | key <- Map.keys requiredByKey, Map.notMember key witnessGroups]+    , duplicate = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, length rows > 1]+    , stale = sortedKeys [key | key <- Map.keys witnessGroups, Map.notMember key requiredByKey]+    , failed = sortOn (unBehaviorKey . (.key)) failures+    , verified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, proofStrength requirement]+    , unverified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, not (proofStrength requirement)]+    }+ where+  requiredByKey = Map.fromList [(requirement.key, 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.pending+    && null report.missing+    && null report.duplicate+    && null report.stale+    && null report.failed+    && (not failOnUnverified || null report.unverified)++renderBehaviorConformanceText :: BehaviorConformanceReport -> Text+renderBehaviorConformanceText report = T.unlines+  [ "behavior conformance: IncidentSaga"+  , "schema: keiro/behavior-conformance/1"+  , countLine "required" report.required+  , countLine "filled" report.filled+  , countLine "pending" report.pending+  , countLine "missing" report.missing+  , countLine "duplicate" report.duplicate+  , countLine "stale" report.stale+  , "failed: " <> tshow (length report.failed)+  , countLine "verified" report.verified+  , countLine "unverified" report.unverified+  ] <> T.unlines ["FAIL " <> unBehaviorKey behaviorFailure.key <> " " <> behaviorFailure.subject <> " [" <> behaviorFailure.code <> "] " <> behaviorFailure.detail | behaviorFailure <- report.failed]++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 -> [IncidentSagaEvent] -> IncidentSagaCommand -> LiveExpectation -> Either BehaviorFailure ()+runLive requirement history command expectation = do+  settled <- settleHistory requirement "history" history+  ensure requirement (K.replaySuccessState settled == requirement.source) "history-wrong-source" "history does not settle at the required source vertex"+  ensure requirement (commandKind command == requirement.commandName) "command-mismatch" "witness command constructor does not match the required state/command cell"+  case requirement.kind 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 -> (IncidentSagaVertex, K.RegFile IncidentSagaRegs) -> IncidentSagaCommand -> LiveExpectation -> Either BehaviorFailure ()+runRejection requirement seed command expectation = case expectation of+  Emits _ -> failure requirement "expectation-kind" "a rejection requirement cannot expect emitted events"+  NoOp -> failure requirement "expectation-kind" "a rejection requirement cannot expect an accepted no-op"+  Rejects expectedClass -> case K.stepDetailedEither incidentSagaTransducer 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 -> (IncidentSagaVertex, K.RegFile IncidentSagaRegs) -> IncidentSagaCommand -> LiveExpectation -> Either BehaviorFailure ()+runAcceptance requirement seed command expectation = case expectation of+  Rejects _ -> failure requirement "expectation-kind" "a live-transition requirement needs Emits or NoOp"+  NoOp -> case K.stepDetailedEither incidentSagaTransducer 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"+  Emits expectedEvents -> case K.stepDetailedEither incidentSagaTransducer 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.eventKinds) "event-envelope-mismatch" ("runtime event kinds differ from the declared ordered envelope; actual=" <> tshow (map eventKind actual) <> " expected=" <> tshow requirement.eventKinds)+      decoded <- either (failure requirement "emitted-codec-decode") Right (decodeEvents actual)+      replayed <- case K.applyEventsDetailedEither incidentSagaTransducer 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)++checkAcceptedEnvelope :: BehaviorRequirement -> K.StepSuccess IncidentSagaRegs IncidentSagaVertex IncidentSagaEvent -> 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.expectedEdge) "edge-attribution" ("runtime selected a different guarded sibling; actual=" <> tshow (Just (K.stepSuccessEdge success)) <> " expected=" <> tshow requirement.expectedEdge)+  ensure requirement (Just (K.stepSuccessState success) == requirement.target) "target-mismatch" ("runtime reached a different target vertex; actual=" <> tshow (Just (K.stepSuccessState success)) <> " expected=" <> tshow requirement.target)++runReplay :: BehaviorRequirement -> [IncidentSagaEvent] -> [IncidentSagaEvent] -> Either BehaviorFailure ()+runReplay requirement prefix chunk = case requirement.kind of+  ReplayTransition -> do+    settled <- settleHistory requirement "history-prefix" prefix+    ensure requirement (K.replaySuccessState settled == requirement.source) "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 incidentSagaTransducer (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.target) "target-mismatch" ("replay chunk reached a different target vertex; actual=" <> tshow (Just (K.replaySuccessState replayed)) <> " expected=" <> tshow requirement.target)+    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 IncidentSagaVertex] -> Either BehaviorFailure ()+checkSingleAttribution requirement expectedMode eventCount trace = case trace of+  [attribution] -> do+    ensure requirement (Just (K.replayAttributionEdge attribution) == requirement.expectedEdge) "replay-edge-attribution" ("replay selected a different edge; actual=" <> tshow (Just (K.replayAttributionEdge attribution)) <> " expected=" <> tshow requirement.expectedEdge)+    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.source) "replay-source-attribution" ("replay attribution starts at the wrong source; actual=" <> tshow (K.replayAttributionSource attribution) <> " expected=" <> tshow requirement.source)+    ensure requirement (Just (K.replayAttributionTarget attribution) == requirement.target) "replay-target-attribution" ("replay attribution ends at the wrong target; actual=" <> tshow (Just (K.replayAttributionTarget attribution)) <> " expected=" <> tshow requirement.target)+    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 -> [IncidentSagaEvent] -> Either BehaviorFailure (K.ReplaySuccess IncidentSagaRegs IncidentSagaVertex)+settleHistory requirement label history = do+  decoded <- either (failure requirement (label <> "-codec-decode")) Right (decodeEvents history)+  case K.applyEventsDetailedEither incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) decoded of+    Left replayFailure -> failure requirement (label <> "-replay-failed") (tshow replayFailure)+    Right replaySuccess -> Right replaySuccess++decodeEvents :: [IncidentSagaEvent] -> Either Text [IncidentSagaEvent]+decodeEvents = traverse (\event -> parseIncidentSagaEvent (Codec.eventType incidentSagaCodec event) (encodeIncidentSagaEvent event))++commandKind :: IncidentSagaCommand -> Text+commandKind command = case command of+  RecordCritical _ -> "RecordCritical"+  RecordRoutine _ -> "RecordRoutine"++eventKind :: IncidentSagaEvent -> Text+eventKind event = case Codec.eventType incidentSagaCodec event of Codec.EventType tag -> tag++regsEqual :: K.RegFile IncidentSagaRegs -> K.RegFile IncidentSagaRegs -> Bool+regsEqual _ _ = True++proofStrength :: BehaviorRequirement -> Bool+proofStrength requirement =+  requirement.evidence == GeneratedAuthoritative+    && requirement.guardCoverage `elem` [GuardTotal, GuardNotApplicable]++behaviorWitnessKey :: BehaviorWitness -> BehaviorKey+behaviorWitnessKey witness = case witness of+  Pending key -> key+  LiveWitness { key = key } -> key+  ReplayWitness { key = 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.key+        (tshow requirement.source <> " x " <> requirement.commandName <> ": " <> kindPhrase <> " (" <> BehaviorSourceMap.renderBehaviorSourceLocation (unBehaviorKey requirement.key) <> ")")+        code+        detail+    )+ where+  kindPhrase = case requirement.kind 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
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/Codec.hs view
@@ -0,0 +1,77 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessReactions.IncidentSaga.Codec (+    incidentSagaCodec,+    parseIncidentSagaEvent,+    encodeIncidentSagaEvent,+) where++import Generated.ProcessReactions.IncidentSaga.Domain+import Generated.ProcessReactions.Nominals (incidentIdText)+import Generated.ProcessReactions.Nominals.Internal (unsafeIncidentIdFromLegacyText)+import Data.Aeson (Value, object, withObject, (.:), (.=))+import Data.Aeson.Types (parseEither)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text (Text)+import qualified Data.Text as T+import Keiro.Codec (Codec (..), EventType (..))++++++incidentSagaEventTypes :: NonEmpty EventType+incidentSagaEventTypes = EventType "CriticalRecorded" :| [EventType "RoutineRecorded"]++incidentSagaCodec :: Codec IncidentSagaEvent+incidentSagaCodec =+  Codec+    { eventTypes = incidentSagaEventTypes+    , eventType = \case+        CriticalRecorded{} -> EventType "CriticalRecorded"+        RoutineRecorded{} -> EventType "RoutineRecorded"+    , schemaVersion = 1+    , encode = encodeIncidentSagaEvent+    , decode = parseIncidentSagaEvent+    , upcasters = []+    }++encodeIncidentSagaEvent :: IncidentSagaEvent -> Value+encodeIncidentSagaEvent = \case+  CriticalRecorded payload ->+    object+      [ "kind" .= ("CriticalRecorded" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]+  RoutineRecorded payload ->+    object+      [ "kind" .= ("RoutineRecorded" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]++parseIncidentSagaEvent :: EventType -> Value -> Either Text IncidentSagaEvent+parseIncidentSagaEvent (EventType tag) = mapLeftText . parseEither (withObject "IncidentSagaEvent" go)+  where+    go o = do+      case tag of+        "CriticalRecorded" ->+          CriticalRecorded+            <$> ( CriticalRecordedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        "RoutineRecorded" ->+          RoutineRecorded+            <$> ( RoutineRecordedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes incidentSagaEventTypes)++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
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/Domain.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE TemplateHaskell #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessReactions.IncidentSaga.Domain where++import GHC.Generics (Generic)+import Keiki.Core (RegFile (..))+import Generated.ProcessReactions.Nominals (IncidentId)+import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)++data IncidentSagaVertex = IncidentSagaOpen+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)++data RecordCriticalData = RecordCriticalData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data RecordRoutineData = RecordRoutineData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentSagaCommand = RecordCritical !RecordCriticalData+  | RecordRoutine !RecordRoutineData+  deriving stock (Generic, Eq, Show)++data CriticalRecordedData = CriticalRecordedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data RoutineRecordedData = RoutineRecordedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentSagaEvent = CriticalRecorded !CriticalRecordedData+  | RoutineRecorded !RoutineRecordedData+  deriving stock (Generic, Eq, Show)++type IncidentSagaRegs =+  '[]++initialIncidentSagaRegs :: RegFile IncidentSagaRegs+initialIncidentSagaRegs =+  RNil++$(deriveAggregateCtorsAll ''IncidentSagaCommand ''IncidentSagaRegs)++++$(deriveWireCtorsAll ''IncidentSagaEvent)
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/EventStream.hs view
@@ -0,0 +1,49 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessReactions.IncidentSaga.EventStream+  ( incidentSagaCategory+  , incidentSagaCommandCategory+  , incidentSagaEventStream+  , incidentSagaEventStreamDef+  , IncidentSagaEventStream+  , IncidentSagaEventStreamDef+  ) where++import Generated.ProcessReactions.IncidentSaga.Domain+import Generated.ProcessReactions.IncidentSaga.Codec (incidentSagaCodec)+import Generated.ProcessReactions.IncidentSaga.Transducer (incidentSagaTransducer)+import Keiki.Core (HsPred)+import Keiro.EventStream (EventStream (..), SnapshotPolicy (..))+import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow)+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.+incidentSagaCategory :: Stream.StreamCategory IncidentSagaEventStreamDef+incidentSagaCategory = Stream.categoryUnsafe "incidentSaga"++-- The same category text, typed for command envelopes such as PMCommand.+incidentSagaCommandCategory :: Stream.StreamCategory IncidentSagaCommand+incidentSagaCommandCategory = Stream.categoryUnsafe "incidentSaga"++type IncidentSagaEventStreamDef =+  EventStream (HsPred IncidentSagaRegs IncidentSagaCommand) IncidentSagaRegs IncidentSagaVertex IncidentSagaCommand IncidentSagaEvent++type IncidentSagaEventStream =+  ValidatedEventStream (HsPred IncidentSagaRegs IncidentSagaCommand) IncidentSagaRegs IncidentSagaVertex IncidentSagaCommand IncidentSagaEvent++incidentSagaEventStreamDef :: IncidentSagaEventStreamDef+incidentSagaEventStreamDef =+  EventStream+    { transducer = incidentSagaTransducer,+      initialState = IncidentSagaOpen,+      initialRegisters = initialIncidentSagaRegs,+      eventCodec = incidentSagaCodec,+      resolveStreamName = Stream.streamName,+      snapshotPolicy = Never,+      stateCodec = Nothing+    }++incidentSagaEventStream :: IncidentSagaEventStream+incidentSagaEventStream =+  mkEventStreamOrThrow "IncidentSaga" incidentSagaEventStreamDef
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/Harness.hs view
@@ -0,0 +1,87 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessReactions.IncidentSaga.Harness (harnessAssertions) where++import Generated.ProcessReactions.IncidentSaga.Domain+import Generated.ProcessReactions.IncidentSaga.Codec (encodeIncidentSagaEvent, parseIncidentSagaEvent, incidentSagaCodec)+import Generated.ProcessReactions.IncidentSaga.Transducer (incidentSagaTransducer)+import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)+import Keiro.Codec (eventType)+import Generated.ProcessReactions.Nominals (IncidentId, parseIncidentId)++-- | (label, passed). A driver runs these and exits non-zero on any False,+-- naming the failing assertion. Filling a hole wrongly turns a specific+-- entry False; the scaffold cannot.+harnessAssertions :: [(String, Bool)]+harnessAssertions =+  [ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions incidentSagaTransducer))+  -- clock-free: spec samples no wall clock (verified at scaffold time)+  , ("golden round-trip: CriticalRecorded", roundTrips sampleEventCriticalRecorded)+  , ("golden round-trip: RoutineRecorded", roundTrips sampleEventRoutineRecorded)+  , ("accepts RecordCritical from IncidentSagaOpen", acceptRecordCritical)+  , ("accepts RecordRoutine from IncidentSagaOpen", acceptRecordRoutine)+  ]+  ++ forwardReplayRecordCritical+  ++ forwardReplayRecordRoutine++roundTrips :: IncidentSagaEvent -> Bool+roundTrips e = parseIncidentSagaEvent (eventType incidentSagaCodec e) (encodeIncidentSagaEvent e) == Right e++sampleIncidentId :: IncidentId+sampleIncidentId =+  case parseIncidentId "inc_01h455vb4pex5vsknk084sn02q" of+    Right parsed -> parsed+    Left problem -> error (show problem)++sampleEventCriticalRecorded :: IncidentSagaEvent+sampleEventCriticalRecorded = CriticalRecorded (CriticalRecordedData sampleIncidentId)++sampleEventRoutineRecorded :: IncidentSagaEvent+sampleEventRoutineRecorded = RoutineRecorded (RoutineRecordedData sampleIncidentId)++acceptRecordCritical :: Bool+acceptRecordCritical =+  case step incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) (RecordCritical (RecordCriticalData sampleIncidentId)) of+    Just (v, _, _) -> v == IncidentSagaOpen+    Nothing -> False++acceptRecordRoutine :: Bool+acceptRecordRoutine =+  case step incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) (RecordRoutine (RecordRoutineData sampleIncidentId)) of+    Just (v, _, _) -> v == IncidentSagaOpen+    Nothing -> False++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayRecordCritical :: [(String, Bool)]+forwardReplayRecordCritical =+  case step incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) (RecordCritical (RecordCriticalData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseIncidentSagaEvent (eventType incidentSagaCodec event) (encodeIncidentSagaEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: RecordCritical from IncidentSagaOpen -- "++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayRecordRoutine :: [(String, Bool)]+forwardReplayRecordRoutine =+  case step incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) (RecordRoutine (RecordRoutineData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseIncidentSagaEvent (eventType incidentSagaCodec event) (encodeIncidentSagaEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: RecordRoutine from IncidentSagaOpen -- "
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/Projection.hs view
@@ -0,0 +1,4 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessReactions.IncidentSaga.Projection () where++-- No projection declarations are present; this module keeps the generated manifest inventory total.
+ test/conformance-process-reactions/Generated/ProcessReactions/IncidentSaga/Transducer.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE QualifiedDo #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessReactions.IncidentSaga.Transducer+  ( incidentSagaTransducer+  , incidentSagaFoldFingerprint+  , BehaviorOwnership (..)+  , incidentSagaPredicateVerifications+  ) where++import Generated.ProcessReactions.IncidentSaga.Domain+import Data.Text (Text)+import Keiki.Builder qualified as B+import Keiki.Core (HsPred, SymTransducer)+import Keiki.Core qualified as K+import Keiki.Symbolic qualified as S++incidentSagaTransducer+  :: SymTransducer+       (HsPred IncidentSagaRegs IncidentSagaCommand)+       IncidentSagaRegs+       IncidentSagaVertex+       IncidentSagaCommand+       IncidentSagaEvent+incidentSagaTransducer =+  B.buildTransducer IncidentSagaOpen initialIncidentSagaRegs isTerminal do+    B.from IncidentSagaOpen do+      B.onCmd inCtorRecordCritical $ \d -> B.do+        B.emit wireCriticalRecorded (CriticalRecordedTermFields+          { incidentId = d.incidentId+          })+        B.goto IncidentSagaOpen+      B.onCmd inCtorRecordRoutine $ \d -> B.do+        B.emit wireRoutineRecorded (RoutineRecordedTermFields+          { incidentId = d.incidentId+          })+        B.goto IncidentSagaOpen+ where+  isTerminal = \case++    _ -> False++incidentSagaFoldFingerprint :: Text+incidentSagaFoldFingerprint = "7fb23db923950d2db78df682f8394668"++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.+incidentSagaPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]+incidentSagaPredicateVerifications = sequence+  [ verifyTransition "transition1OpenRecordCritical" GeneratedOwned IncidentSagaOpen 0+  , verifyTransition "transition2OpenRecordRoutine" GeneratedOwned IncidentSagaOpen 1+  ]+ where+  verifyTransition label owner source edgeIndex =+    case drop edgeIndex (K.edgesOut incidentSagaTransducer source) of+      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate+      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")
+ test/conformance-process-reactions/Generated/ProcessReactions/Nominals.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveAnyClass #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context process-reactions generated nominal declarations; do not edit.+module Generated.ProcessReactions.Nominals+  ( IncidentId+  , parseIncidentId+  , mkIncidentId+  , incidentIdText+  , Severity (..)+  , severityText+  ) where++import Data.Aeson (FromJSON, ToJSON)+import Data.Text (Text)+import GHC.Generics (Generic)+import Keiki.Shape (CanonicalTypeName)+import Generated.ProcessReactions.Nominals.Internal (IncidentId, mkIncidentId, parseIncidentId, incidentIdText)++++data Severity = Sev1 | Sev2+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)+  deriving anyclass (ToJSON, FromJSON)++instance CanonicalTypeName Severity++severityText :: Severity -> Text+severityText = \case+  Sev1 -> "sev1"+  Sev2 -> "sev2"
+ test/conformance-process-reactions/Generated/ProcessReactions/Nominals/Internal.hs view
@@ -0,0 +1,40 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context process-reactions generated nominal ID internals; do not edit.+module Generated.ProcessReactions.Nominals.Internal+  ( IncidentId+  , parseIncidentId+  , mkIncidentId+  , incidentIdText+  , unsafeIncidentIdFromLegacyText+  ) 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)++newtype IncidentId = IncidentId Text+  deriving stock (Generic, Eq, Ord, Show)++instance CanonicalTypeName IncidentId++instance ToJSON IncidentId where+  toJSON = toJSON . incidentIdText++instance FromJSON IncidentId where+  parseJSON = withText "IncidentId" (either (fail . T.unpack) pure . parseIncidentId)++parseIncidentId :: Text -> Either Text IncidentId+parseIncidentId input = case validateIdDomainText (typeIdV7Domain "inc") input of+  Left reason -> Left (T.pack (show reason))+  Right () -> Right (IncidentId input)++mkIncidentId :: Text -> Either Text IncidentId+mkIncidentId = parseIncidentId++incidentIdText :: IncidentId -> Text+incidentIdText (IncidentId value) = value++unsafeIncidentIdFromLegacyText :: Text -> IncidentId+unsafeIncidentIdFromLegacyText = IncidentId
+ test/conformance-process-reactions/Generated/ProcessReactions/ReplayAudit.hs view
@@ -0,0 +1,30 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context process-reactions replay-audit assembly; do not edit.+--+-- 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 Generated.ProcessReactions.ReplayAudit (auditTargets) where++import Generated.ProcessReactions.IncidentSaga.EventStream qualified as IncidentSaga+import Generated.ProcessReactions.Incident.EventStream qualified as Incident+import Keiro.ReplayAudit (AuditTarget (..), SomeAuditTarget (..), streamInCategory)+import Keiro.Stream qualified as Stream++auditTargets :: [SomeAuditTarget]+auditTargets =+  [ SomeAuditTarget+      AuditTarget+        { eventStream = IncidentSaga.incidentSagaEventStream+        , category = Stream.categoryText IncidentSaga.incidentSagaCategory+        , mkStream = streamInCategory (Stream.categoryText IncidentSaga.incidentSagaCategory)+        }+  , SomeAuditTarget+      AuditTarget+        { eventStream = Incident.incidentEventStream+        , category = Stream.categoryText Incident.incidentCategory+        , mkStream = streamInCategory (Stream.categoryText Incident.incidentCategory)+        }+  ]
+ test/conformance-process-reactions/Generated/ProcessReactions/ScalingReaction/Input.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE DeriveAnyClass #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process input ScalingReaction; do not edit.+module Generated.ProcessReactions.ScalingReaction.Input (ScalingReactionInput (..)) where++import Data.Aeson (FromJSON, ToJSON)+import GHC.Generics (Generic)+import Generated.ProcessReactions.Nominals qualified as N++data ScalingReactionInput+  = FanOut8Same+      { incidentId :: !N.IncidentId+      }+  | FanOut32Same+      { incidentId :: !N.IncidentId+      }+  | FanOut128Same+      { incidentId :: !N.IncidentId+      }+  | FanOut8Distinct+      { incidentId :: !N.IncidentId+      , target001 :: !N.IncidentId+      , target002 :: !N.IncidentId+      , target003 :: !N.IncidentId+      , target004 :: !N.IncidentId+      , target005 :: !N.IncidentId+      , target006 :: !N.IncidentId+      , target007 :: !N.IncidentId+      , target008 :: !N.IncidentId+      }+  | FanOut32Distinct+      { incidentId :: !N.IncidentId+      , target001 :: !N.IncidentId+      , target002 :: !N.IncidentId+      , target003 :: !N.IncidentId+      , target004 :: !N.IncidentId+      , target005 :: !N.IncidentId+      , target006 :: !N.IncidentId+      , target007 :: !N.IncidentId+      , target008 :: !N.IncidentId+      , target009 :: !N.IncidentId+      , target010 :: !N.IncidentId+      , target011 :: !N.IncidentId+      , target012 :: !N.IncidentId+      , target013 :: !N.IncidentId+      , target014 :: !N.IncidentId+      , target015 :: !N.IncidentId+      , target016 :: !N.IncidentId+      , target017 :: !N.IncidentId+      , target018 :: !N.IncidentId+      , target019 :: !N.IncidentId+      , target020 :: !N.IncidentId+      , target021 :: !N.IncidentId+      , target022 :: !N.IncidentId+      , target023 :: !N.IncidentId+      , target024 :: !N.IncidentId+      , target025 :: !N.IncidentId+      , target026 :: !N.IncidentId+      , target027 :: !N.IncidentId+      , target028 :: !N.IncidentId+      , target029 :: !N.IncidentId+      , target030 :: !N.IncidentId+      , target031 :: !N.IncidentId+      , target032 :: !N.IncidentId+      }+  | FanOut128Distinct+      { incidentId :: !N.IncidentId+      , target001 :: !N.IncidentId+      , target002 :: !N.IncidentId+      , target003 :: !N.IncidentId+      , target004 :: !N.IncidentId+      , target005 :: !N.IncidentId+      , target006 :: !N.IncidentId+      , target007 :: !N.IncidentId+      , target008 :: !N.IncidentId+      , target009 :: !N.IncidentId+      , target010 :: !N.IncidentId+      , target011 :: !N.IncidentId+      , target012 :: !N.IncidentId+      , target013 :: !N.IncidentId+      , target014 :: !N.IncidentId+      , target015 :: !N.IncidentId+      , target016 :: !N.IncidentId+      , target017 :: !N.IncidentId+      , target018 :: !N.IncidentId+      , target019 :: !N.IncidentId+      , target020 :: !N.IncidentId+      , target021 :: !N.IncidentId+      , target022 :: !N.IncidentId+      , target023 :: !N.IncidentId+      , target024 :: !N.IncidentId+      , target025 :: !N.IncidentId+      , target026 :: !N.IncidentId+      , target027 :: !N.IncidentId+      , target028 :: !N.IncidentId+      , target029 :: !N.IncidentId+      , target030 :: !N.IncidentId+      , target031 :: !N.IncidentId+      , target032 :: !N.IncidentId+      , target033 :: !N.IncidentId+      , target034 :: !N.IncidentId+      , target035 :: !N.IncidentId+      , target036 :: !N.IncidentId+      , target037 :: !N.IncidentId+      , target038 :: !N.IncidentId+      , target039 :: !N.IncidentId+      , target040 :: !N.IncidentId+      , target041 :: !N.IncidentId+      , target042 :: !N.IncidentId+      , target043 :: !N.IncidentId+      , target044 :: !N.IncidentId+      , target045 :: !N.IncidentId+      , target046 :: !N.IncidentId+      , target047 :: !N.IncidentId+      , target048 :: !N.IncidentId+      , target049 :: !N.IncidentId+      , target050 :: !N.IncidentId+      , target051 :: !N.IncidentId+      , target052 :: !N.IncidentId+      , target053 :: !N.IncidentId+      , target054 :: !N.IncidentId+      , target055 :: !N.IncidentId+      , target056 :: !N.IncidentId+      , target057 :: !N.IncidentId+      , target058 :: !N.IncidentId+      , target059 :: !N.IncidentId+      , target060 :: !N.IncidentId+      , target061 :: !N.IncidentId+      , target062 :: !N.IncidentId+      , target063 :: !N.IncidentId+      , target064 :: !N.IncidentId+      , target065 :: !N.IncidentId+      , target066 :: !N.IncidentId+      , target067 :: !N.IncidentId+      , target068 :: !N.IncidentId+      , target069 :: !N.IncidentId+      , target070 :: !N.IncidentId+      , target071 :: !N.IncidentId+      , target072 :: !N.IncidentId+      , target073 :: !N.IncidentId+      , target074 :: !N.IncidentId+      , target075 :: !N.IncidentId+      , target076 :: !N.IncidentId+      , target077 :: !N.IncidentId+      , target078 :: !N.IncidentId+      , target079 :: !N.IncidentId+      , target080 :: !N.IncidentId+      , target081 :: !N.IncidentId+      , target082 :: !N.IncidentId+      , target083 :: !N.IncidentId+      , target084 :: !N.IncidentId+      , target085 :: !N.IncidentId+      , target086 :: !N.IncidentId+      , target087 :: !N.IncidentId+      , target088 :: !N.IncidentId+      , target089 :: !N.IncidentId+      , target090 :: !N.IncidentId+      , target091 :: !N.IncidentId+      , target092 :: !N.IncidentId+      , target093 :: !N.IncidentId+      , target094 :: !N.IncidentId+      , target095 :: !N.IncidentId+      , target096 :: !N.IncidentId+      , target097 :: !N.IncidentId+      , target098 :: !N.IncidentId+      , target099 :: !N.IncidentId+      , target100 :: !N.IncidentId+      , target101 :: !N.IncidentId+      , target102 :: !N.IncidentId+      , target103 :: !N.IncidentId+      , target104 :: !N.IncidentId+      , target105 :: !N.IncidentId+      , target106 :: !N.IncidentId+      , target107 :: !N.IncidentId+      , target108 :: !N.IncidentId+      , target109 :: !N.IncidentId+      , target110 :: !N.IncidentId+      , target111 :: !N.IncidentId+      , target112 :: !N.IncidentId+      , target113 :: !N.IncidentId+      , target114 :: !N.IncidentId+      , target115 :: !N.IncidentId+      , target116 :: !N.IncidentId+      , target117 :: !N.IncidentId+      , target118 :: !N.IncidentId+      , target119 :: !N.IncidentId+      , target120 :: !N.IncidentId+      , target121 :: !N.IncidentId+      , target122 :: !N.IncidentId+      , target123 :: !N.IncidentId+      , target124 :: !N.IncidentId+      , target125 :: !N.IncidentId+      , target126 :: !N.IncidentId+      , target127 :: !N.IncidentId+      , target128 :: !N.IncidentId+      }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromJSON, ToJSON)
+ test/conformance-process-reactions/Generated/ProcessReactions/ScalingReaction/Process.hs view
@@ -0,0 +1,93 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process reaction ScalingReaction; do not edit.+module Generated.ProcessReactions.ScalingReaction.Process+  ( ScalingReactionInput (..)+  , scalingReactionProcessName+  , scalingReactionCategory+  , scalingReactionProcessWorkerOptions+  , scalingReactionReactionVersion+  , scalingReactionReactionFingerprint+  , scalingReactionReact+  , scalingReactionProcessManager+  , scalingReactionRunProcessWorker+  ) where++import Data.Text (Text)+import Numeric.Natural (Natural)+import Generated.ProcessReactions.ScalingReaction.Input (ScalingReactionInput (..))+import ProcessReactions.ScalingReaction.ProcessHoles (decodeScalingReactionInput)+import Generated.ProcessReactions.IncidentSaga.Domain qualified as Saga+import Generated.ProcessReactions.IncidentSaga.EventStream (incidentSagaEventStream, IncidentSagaEventStreamDef)+import Generated.ProcessReactions.Incident.Domain qualified as Target+import Generated.ProcessReactions.Incident.EventStream (incidentCommandCategory, incidentEventStream)+import Generated.ProcessReactions.Nominals qualified as N+import Keiro.Command (DomainCommandHandler (..), SilentDomainDecision (..))+import Keiro.ProcessManager (PMCommand (..))+import Keiro.ProcessManager.Reaction qualified as Reaction+import Keiro.Stream qualified as Stream+import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))+import Shibuya.Core.Ack (RetryDelay (..))++scalingReactionProcessName :: Text+scalingReactionProcessName = "scaling-reaction"++scalingReactionCategory :: Stream.StreamCategory IncidentSagaEventStreamDef+scalingReactionCategory = Stream.categoryUnsafe "scalingSaga"++scalingReactionProcessWorkerOptions :: WorkerOptions es msg+scalingReactionProcessWorkerOptions =+  WorkerOptions+    { poisonPolicy = PoisonHalt,+      rejectedCommandPolicy = RejectedHalt,+      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning+      metrics = Nothing -- runtime configuration; install at call site+    }++scalingReactionReactionVersion :: Natural+scalingReactionReactionVersion = 1++scalingReactionReactionFingerprint :: Text+scalingReactionReactionFingerprint = "8329eab62dfa1917a468c914b9bbb7cae121b5d353656e69543f6aa95a43a14f"++scalingReactionCorrelate :: ScalingReactionInput -> Text+scalingReactionCorrelate input = case input of+  FanOut8Same { incidentId } -> (N.incidentIdText incidentId)+  FanOut32Same { incidentId } -> (N.incidentIdText incidentId)+  FanOut128Same { incidentId } -> (N.incidentIdText incidentId)+  FanOut8Distinct { incidentId } -> (N.incidentIdText incidentId)+  FanOut32Distinct { incidentId } -> (N.incidentIdText incidentId)+  FanOut128Distinct { incidentId } -> (N.incidentIdText incidentId)++scalingReactionReact :: ScalingReactionInput -> Reaction.ReactionPlan Saga.IncidentSagaCommand Target.IncidentCommand+scalingReactionReact input = case input of+  FanOut8Same { incidentId }+    -> Reaction.AdvanceReaction { command = Saga.RecordCritical (Saga.RecordCriticalData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId })))], onAccepted = [] }+  FanOut32Same { incidentId }+    -> Reaction.AdvanceReaction { command = Saga.RecordCritical (Saga.RecordCriticalData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId })))], onAccepted = [] }+  FanOut128Same { incidentId }+    -> Reaction.AdvanceReaction { command = Saga.RecordCritical (Saga.RecordCriticalData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = incidentId })))], onAccepted = [] }+  FanOut8Distinct { incidentId, target001, target002, target003, target004, target005, target006, target007, target008 }+    -> Reaction.AdvanceReaction { command = Saga.RecordCritical (Saga.RecordCriticalData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target001)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target001 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target002)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target002 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target003)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target003 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target004)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target004 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target005)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target005 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target006)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target006 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target007)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target007 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target008)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target008 })))], onAccepted = [] }+  FanOut32Distinct { incidentId, target001, target002, target003, target004, target005, target006, target007, target008, target009, target010, target011, target012, target013, target014, target015, target016, target017, target018, target019, target020, target021, target022, target023, target024, target025, target026, target027, target028, target029, target030, target031, target032 }+    -> Reaction.AdvanceReaction { command = Saga.RecordCritical (Saga.RecordCriticalData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target001)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target001 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target002)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target002 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target003)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target003 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target004)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target004 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target005)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target005 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target006)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target006 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target007)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target007 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target008)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target008 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target009)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target009 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target010)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target010 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target011)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target011 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target012)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target012 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target013)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target013 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target014)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target014 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target015)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target015 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target016)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target016 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target017)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target017 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target018)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target018 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target019)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target019 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target020)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target020 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target021)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target021 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target022)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target022 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target023)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target023 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target024)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target024 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target025)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target025 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target026)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target026 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target027)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target027 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target028)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target028 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target029)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target029 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target030)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target030 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target031)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target031 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target032)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target032 })))], onAccepted = [] }+  FanOut128Distinct { incidentId, target001, target002, target003, target004, target005, target006, target007, target008, target009, target010, target011, target012, target013, target014, target015, target016, target017, target018, target019, target020, target021, target022, target023, target024, target025, target026, target027, target028, target029, target030, target031, target032, target033, target034, target035, target036, target037, target038, target039, target040, target041, target042, target043, target044, target045, target046, target047, target048, target049, target050, target051, target052, target053, target054, target055, target056, target057, target058, target059, target060, target061, target062, target063, target064, target065, target066, target067, target068, target069, target070, target071, target072, target073, target074, target075, target076, target077, target078, target079, target080, target081, target082, target083, target084, target085, target086, target087, target088, target089, target090, target091, target092, target093, target094, target095, target096, target097, target098, target099, target100, target101, target102, target103, target104, target105, target106, target107, target108, target109, target110, target111, target112, target113, target114, target115, target116, target117, target118, target119, target120, target121, target122, target123, target124, target125, target126, target127, target128 }+    -> Reaction.AdvanceReaction { command = Saga.RecordCritical (Saga.RecordCriticalData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target001)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target001 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target002)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target002 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target003)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target003 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target004)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target004 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target005)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target005 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target006)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target006 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target007)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target007 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target008)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target008 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target009)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target009 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target010)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target010 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target011)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target011 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target012)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target012 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target013)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target013 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target014)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target014 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target015)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target015 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target016)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target016 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target017)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target017 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target018)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target018 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target019)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target019 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target020)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target020 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target021)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target021 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target022)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target022 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target023)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target023 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target024)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target024 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target025)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target025 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target026)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target026 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target027)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target027 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target028)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target028 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target029)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target029 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target030)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target030 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target031)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target031 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target032)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target032 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target033)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target033 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target034)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target034 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target035)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target035 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target036)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target036 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target037)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target037 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target038)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target038 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target039)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target039 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target040)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target040 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target041)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target041 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target042)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target042 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target043)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target043 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target044)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target044 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target045)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target045 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target046)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target046 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target047)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target047 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target048)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target048 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target049)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target049 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target050)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target050 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target051)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target051 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target052)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target052 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target053)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target053 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target054)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target054 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target055)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target055 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target056)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target056 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target057)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target057 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target058)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target058 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target059)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target059 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target060)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target060 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target061)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target061 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target062)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target062 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target063)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target063 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target064)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target064 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target065)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target065 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target066)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target066 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target067)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target067 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target068)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target068 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target069)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target069 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target070)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target070 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target071)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target071 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target072)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target072 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target073)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target073 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target074)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target074 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target075)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target075 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target076)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target076 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target077)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target077 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target078)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target078 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target079)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target079 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target080)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target080 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target081)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target081 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target082)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target082 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target083)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target083 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target084)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target084 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target085)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target085 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target086)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target086 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target087)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target087 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target088)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target088 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target089)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target089 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target090)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target090 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target091)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target091 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target092)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target092 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target093)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target093 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target094)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target094 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target095)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target095 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target096)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target096 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target097)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target097 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target098)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target098 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target099)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target099 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target100)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target100 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target101)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target101 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target102)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target102 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target103)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target103 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target104)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target104 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target105)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target105 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target106)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target106 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target107)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target107 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target108)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target108 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target109)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target109 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target110)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target110 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target111)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target111 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target112)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target112 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target113)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target113 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target114)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target114 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target115)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target115 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target116)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target116 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target117)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target117 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target118)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target118 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target119)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target119 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target120)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target120 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target121)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target121 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target122)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target122 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target123)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target123 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target124)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target124 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target125)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target125 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target126)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target126 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target127)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target127 }))), Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText target128)) (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = target128 })))], onAccepted = [] }++scalingReactionProcessManager =+  Reaction.ReactiveProcessManager+    { name = scalingReactionProcessName+    , correlate = scalingReactionCorrelate+    , sagaHandler = DomainCommandHandler { eventStream = incidentSagaEventStream, classifySilent = \_ -> SilentNoOp () }+    , streamFor = Stream.entityStream scalingReactionCategory+    , targetEventStream = incidentEventStream+    , targetProjections = const []+    , react = scalingReactionReact+    }++scalingReactionRunProcessWorker options adapter =+  Reaction.runReactiveProcessManagerWorkerWith+    scalingReactionProcessWorkerOptions+    options+    scalingReactionProcessManager+    adapter+    (\event -> case decodeScalingReactionInput event of Nothing -> Nothing; Just input -> Just (event, input))
+ test/conformance-process-reactions/Generated/ProcessReactions/ScalingReaction/ProcessHarness.hs view
@@ -0,0 +1,21 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process ScalingReaction; do not edit.+module Generated.ProcessReactions.ScalingReaction.ProcessHarness (processHarnessValues) where++-- | (label, value): the spec's deterministic process/timer decisions,+-- lowered to plain values so a driver can assert them against a committed+-- expectation. The driver's expectation is hand-written (not generated), so a+-- spec change that alters a decision diverges from it and turns a specific+-- assertion red — the spec->behaviour pin. (Live-runtime behavioural+-- conformance of the filled ProcessManager is the M5 step.)+processHarnessValues :: [(String, String)]+processHarnessValues =+  [ ("reactionOwnership", "generated-declarative")+  , ("reactionVersion", "1")+  , ("reactionFingerprint", "8329eab62dfa1917a468c914b9bbb7cae121b5d353656e69543f6aa95a43a14f")+  , ("reaction.FanOut8Same.0", "guard=always;advance=RecordCritical;followUps=dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident;accepted=")+  , ("reaction.FanOut32Same.0", "guard=always;advance=RecordCritical;followUps=dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident;accepted=")+  , ("reaction.FanOut128Same.0", "guard=always;advance=RecordCritical;followUps=dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident;accepted=")+  , ("reaction.FanOut8Distinct.0", "guard=always;advance=RecordCritical;followUps=dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident;accepted=")+  , ("reaction.FanOut32Distinct.0", "guard=always;advance=RecordCritical;followUps=dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident;accepted=")+  , ("reaction.FanOut128Distinct.0", "guard=always;advance=RecordCritical;followUps=dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident,dispatch:Incident.EscalateIncident;accepted=")+  ]
+ test/conformance-process-reactions/Main.hs view
@@ -0,0 +1,218 @@+module Main (main) where++import Control.Monad (unless)+import Data.Aeson (ToJSON)+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Aeson.Key+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Time (UTCTime (..), secondsToDiffTime)+import Data.Time.Calendar (Day (ModifiedJulianDay))+import Data.UUID (UUID)+import Data.UUID qualified as UUID+import Data.UUID.V5 qualified as UUID.V5+import Data.Vector qualified as Vector+import Effectful (IOE, liftIO, (:>))+import Generated.ProcessReactions.AuditOnly.Process qualified as Audit+import Generated.ProcessReactions.Incident.Domain qualified as Target+import Generated.ProcessReactions.IncidentReaction.Process+import Generated.ProcessReactions.IncidentSaga.Domain qualified as Saga+import Generated.ProcessReactions.Nominals (IncidentId, Severity (..), incidentIdText, mkIncidentId)+import Generated.ProcessReactions.ScalingReaction.Process qualified as Scaling+import Keiro.Command (defaultRunCommandOptions)+import Keiro.ProcessManager (PMCommand (..))+import Keiro.ProcessManager.Reaction qualified as Reaction+import Keiro.Test.Postgres (StoreRunner (..), withFreshResourceStore, withMigratedSuite)+import Kiroku.Store qualified as Store+import Kiroku.Store.Types (EventId (..), EventType (..), GlobalPosition (..), RecordedEvent (..), StreamId (..), StreamName (..), StreamVersion (..))+import Shibuya.Adapter (Adapter (..))+import Shibuya.Core.Ack (AckDecision (..))+import Shibuya.Core.AckHandle (AckHandle (..))+import Shibuya.Core.Ingested (Ingested (..))+import Shibuya.Core.Types (Envelope (..))+import Streamly.Data.Stream qualified as Streamly+import System.Environment (getArgs)+import System.IO (hPutStrLn, stderr)++main :: IO ()+main = getArgs >>= \case+  [] -> regularMain+  ["--hydration-probe"] -> hydrationProbeMain+  arguments -> fail ("unexpected arguments: " <> show arguments)++regularMain :: IO ()+regularMain =+  withMigratedSuite $ \fixture ->+    withFreshResourceStore fixture $ \(_storeHandle, StoreRunner runStore) -> do+      incidentId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn02q")+      let critical = IncidentReported incidentId Sev1+          routine = IncidentReported incidentId Sev2+          noted = IncidentNoted incidentId+          criticalSource = recorded sourceUuid1 1 "IncidentReported" critical+          routineSource = recorded sourceUuid2 2 "IncidentReported" routine+          notedSource = recorded sourceUuid3 3 "IncidentNoted" noted++      assert "guarded Sev1 arm" $ case incidentReactionReact critical of+        Reaction.AdvanceReaction+          { command = Saga.RecordCritical (Saga.RecordCriticalData recordedId),+            followUps = [Reaction.FollowDispatch (PMCommand _ (Target.EscalateIncident (Target.EscalateIncidentData targetId)))],+            onAccepted = []+          } -> recordedId == incidentId && targetId == incidentId+        _ -> False+      assert "routine otherwise arm" $ case incidentReactionReact routine of+        Reaction.AdvanceReaction+          { command = Saga.RecordRoutine (Saga.RecordRoutineData recordedId),+            followUps = [],+            onAccepted = []+          } -> recordedId == incidentId+        _ -> False+      assert "no-action input" $ case incidentReactionReact noted of+        Reaction.NoAdvance [] -> True+        _ -> False+      assert "timer-free audit process" $ case Audit.auditOnlyReact (Audit.IncidentNoted incidentId) of+        Reaction.NoAdvance [] -> True+        _ -> False++      acknowledgements <- newIORef []+      expectRight+        =<< runStore+          ( incidentReactionRunProcessWorker+              defaultRunCommandOptions+              (inMemoryAdapter "incident-reaction-conformance" acknowledgements [criticalSource, routineSource, notedSource, criticalSource])+          )+      readIORef acknowledgements >>= assert "guard variants, no-action, and duplicate acknowledge" . (== replicate 4 AckOk)++      auditAcks <- newIORef []+      expectRight+        =<< runStore+          ( Audit.auditOnlyRunProcessWorker+              defaultRunCommandOptions+              (inMemoryAdapter "audit-only-conformance" auditAcks [recorded sourceUuid4 4 "IncidentNoted" (Audit.IncidentNoted incidentId)])+          )+      readIORef auditAcks >>= assert "timer-free no-action worker acknowledges" . (== [AckOk])++      let key = incidentIdText incidentId+      sagaEvents <- expectRight =<< runStore (Store.readStreamForward (StreamName ("incidentSaga-" <> key)) (StreamVersion 0) 10)+      targetEvents <- expectRight =<< runStore (Store.readStreamForward (StreamName ("incident-" <> key)) (StreamVersion 0) 10)+      auditEvents <- expectRight =<< runStore (Store.readStreamForward (StreamName ("incidentAudit-" <> key)) (StreamVersion 0) 10)+      assert "both guarded variants append saga events exactly once" (Vector.length sagaEvents == 2)+      assert "only Sev1 dispatches" (Vector.length targetEvents == 1)+      assert "no-action process appends nothing" (Vector.null auditEvents)++      duplicate <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentReactionProcessManager criticalSource critical)+      assert "public once runner observes duplicate witness" $ case duplicate of+        Right result -> case Reaction.managerResult result of+          Reaction.ReactionDuplicate {} -> True+          _ -> False+        Left _ -> False+      putStrLn "process reaction conformance: PASS"++hydrationProbeMain :: IO ()+hydrationProbeMain =+  withMigratedSuite $ \fixture ->+    withFreshResourceStore fixture $ \(_storeHandle, StoreRunner runStore) -> do+      emptyId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn09z")+      let noAdvance = IncidentNoted emptyId+          noAdvanceSource = recorded sourceUuid2 2 "IncidentNoted" noAdvance+          run input event = expectRight =<< (expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentReactionProcessManager event input))+          runScaling input event = do+            _ <- expectRight =<< (expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions Scaling.scalingReactionProcessManager event input))+            pure ()+          bracketCase label action = do+            hPutStrLn stderr ("reaction-case-start " <> Text.unpack label)+            result <- action+            hPutStrLn stderr ("reaction-case-end " <> Text.unpack label)+            pure result+      mapM_ (probeFanOutCase bracketCase runScaling) [(8, False), (32, False), (128, False), (8, True), (32, True), (128, True)]+      _ <- bracketCase "no-advance" (run noAdvance noAdvanceSource)+      putStrLn "hydration probe conformance: PASS fan-out=8,32,128 shapes=same,distinct"++probeFanOutCase :: (Text -> IO () -> IO ()) -> (Scaling.ScalingReactionInput -> RecordedEvent -> IO ()) -> (Int, Bool) -> IO ()+probeFanOutCase bracketCase runScaling (count, distinct) = do+  correlation <- scalingId (1000 + shapeOffset)+  targets <- traverse scalingId [targetOffset + 1 .. targetOffset + count]+  input <- scalingInput count distinct correlation targets+  let shape = if distinct then "distinct" else "same"+      coordinate = "fanout-" <> Text.pack (show count) <> "-" <> shape+      source = recorded (probeSourceUuid coordinate) (3000 + shapeOffset) ("FanOut" <> Text.pack (show count) <> if distinct then "Distinct" else "Same") input+  bracketCase (coordinate <> "-first-delivery") (runScaling input source)+  bracketCase (coordinate <> "-accepted-redelivery") (runScaling input source)+  where+    shapeOffset = count + if distinct then 500 else 0+    targetOffset = 10000 + shapeOffset * 200++scalingInput :: Int -> Bool -> IncidentId -> [IncidentId] -> IO Scaling.ScalingReactionInput+scalingInput count distinct correlation targets =+  case Aeson.fromJSON encoded of+    Aeson.Error problem -> fail problem+    Aeson.Success input -> pure input+  where+    shape = if distinct then "Distinct" else "Same"+    tag = "FanOut" <> Text.pack (show count) <> shape+    targetFields =+      if distinct+        then zipWith (\index target -> Aeson.Key.fromText ("target" <> Text.justifyRight 3 '0' (Text.pack (show index))) Aeson..= target) [1 :: Int ..] targets+        else []+    encoded = Aeson.object (("tag" Aeson..= tag) : ("incidentId" Aeson..= correlation) : targetFields)++scalingId :: Int -> IO IncidentId+scalingId value = either (fail . show) pure (mkIncidentId ("inc_01h455vb4pex5vsknk084s" <> Text.justifyRight 4 '0' (base32 value)))++base32 :: Int -> Text+base32 value+  | value < 32 = Text.singleton (Text.index alphabet value)+  | otherwise = base32 (value `div` 32) <> Text.singleton (Text.index alphabet (value `mod` 32))+  where+    alphabet = "0123456789abcdefghjkmnpqrstvwxyz"++probeSourceUuid :: Text -> UUID+probeSourceUuid label = UUID.V5.generateNamed UUID.V5.namespaceURL (map (fromIntegral . fromEnum) (Text.unpack label))++recorded :: (ToJSON input) => UUID -> Int -> Text -> input -> RecordedEvent+recorded eventUuid position eventName input =+  RecordedEvent+    { eventId = EventId eventUuid,+      eventType = EventType eventName,+      streamVersion = StreamVersion (fromIntegral position),+      globalPosition = GlobalPosition (fromIntegral position),+      originalStreamId = StreamId 1,+      originalVersion = StreamVersion (fromIntegral position),+      payload = Aeson.toJSON input,+      metadata = Nothing,+      causationId = Nothing,+      correlationId = Nothing,+      createdAt = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime (fromIntegral position))+    }++sourceUuid1, sourceUuid2, sourceUuid3, sourceUuid4 :: UUID+sourceUuid1 = staticUuid "123e4567-e89b-72d3-a456-426614174001"+sourceUuid2 = staticUuid "123e4567-e89b-72d3-a456-426614174002"+sourceUuid3 = staticUuid "123e4567-e89b-72d3-a456-426614174003"+sourceUuid4 = staticUuid "123e4567-e89b-72d3-a456-426614174004"++staticUuid :: String -> UUID+staticUuid value = case UUID.fromString value of+  Just parsed -> parsed+  Nothing -> error "invalid static source UUID"++inMemoryAdapter :: (IOE :> es) => Text -> IORef [AckDecision] -> [msg] -> Adapter es msg+inMemoryAdapter name decisions messages =+  Adapter+    { adapterName = name,+      source = Streamly.fromList (map ingest messages),+      shutdown = pure ()+    }+  where+    ingest message =+      Ingested+        { envelope = Envelope "message" Nothing Nothing Nothing Nothing Nothing Nothing mempty message,+          ack = AckHandle (\decision -> liftIO (modifyIORef' decisions (<> [decision]))),+          lease = Nothing+        }++expectRight :: (Show problem) => Either problem value -> IO value+expectRight = either (error . show) pure++assert :: String -> Bool -> IO ()+assert label condition = unless condition (error ("process reaction conformance failed: " <> label))
+ test/conformance-process-reactions/ProcessReactions/AuditOnly/ProcessHoles.hs view
@@ -0,0 +1,11 @@+-- keiro-dsl process-hole contract v1+-- HAND-OWNED typed decoder; created once and never overwritten.+module ProcessReactions.AuditOnly.ProcessHoles (decodeAuditOnlyInput) where++import Data.Aeson (parseJSON)+import Data.Aeson.Types (parseMaybe)+import Generated.ProcessReactions.AuditOnly.Input (AuditOnlyInput)+import Kiroku.Store.Types (RecordedEvent (..))++decodeAuditOnlyInput :: RecordedEvent -> Maybe AuditOnlyInput+decodeAuditOnlyInput RecordedEvent {payload} = parseMaybe parseJSON payload
+ test/conformance-process-reactions/ProcessReactions/Incident/BehaviorHoles.hs view
@@ -0,0 +1,9 @@+-- Consumer-owned behavioral witnesses. Created once; never overwritten.+module ProcessReactions.Incident.BehaviorHoles (behaviorWitnesses) where++import Generated.ProcessReactions.Incident.BehaviorContract++behaviorWitnesses :: [BehaviorWitness]+behaviorWitnesses =+  [ Pending (BehaviorKey "behavior-v1-4126b087f05aadf6") -- IncidentOpen x EscalateIncident: live transition+  ]
+ test/conformance-process-reactions/ProcessReactions/IncidentReaction/ProcessHoles.hs view
@@ -0,0 +1,11 @@+-- keiro-dsl process-hole contract v1+-- HAND-OWNED typed decoder; created once and never overwritten.+module ProcessReactions.IncidentReaction.ProcessHoles (decodeIncidentReactionInput) where++import Data.Aeson (parseJSON)+import Data.Aeson.Types (parseMaybe)+import Generated.ProcessReactions.IncidentReaction.Input (IncidentReactionInput)+import Kiroku.Store.Types (RecordedEvent (..))++decodeIncidentReactionInput :: RecordedEvent -> Maybe IncidentReactionInput+decodeIncidentReactionInput RecordedEvent {payload} = parseMaybe parseJSON payload
+ test/conformance-process-reactions/ProcessReactions/IncidentSaga/BehaviorHoles.hs view
@@ -0,0 +1,10 @@+-- Consumer-owned behavioral witnesses. Created once; never overwritten.+module ProcessReactions.IncidentSaga.BehaviorHoles (behaviorWitnesses) where++import Generated.ProcessReactions.IncidentSaga.BehaviorContract++behaviorWitnesses :: [BehaviorWitness]+behaviorWitnesses =+  [ Pending (BehaviorKey "behavior-v1-6b66722f9f2463d3") -- IncidentSagaOpen x RecordCritical: live transition+  , Pending (BehaviorKey "behavior-v1-825e6c1709cb63b4") -- IncidentSagaOpen x RecordRoutine: live transition+  ]
+ test/conformance-process-reactions/ProcessReactions/ScalingReaction/ProcessHoles.hs view
@@ -0,0 +1,9 @@+-- keiro-dsl process-hole contract v1+-- HAND-OWNED typed decoder; created once and never overwritten.+module ProcessReactions.ScalingReaction.ProcessHoles (decodeScalingReactionInput) where++import Generated.ProcessReactions.ScalingReaction.Input (ScalingReactionInput)+import Kiroku.Store.Types (RecordedEvent)++decodeScalingReactionInput :: RecordedEvent -> Maybe ScalingReactionInput+decodeScalingReactionInput = error "fill decodeScalingReactionInput"
+ test/conformance-process-reactions/keiro-dsl-cabal-fragment.context.process-reactions-minimal.txt view
@@ -0,0 +1,46 @@+-- keiro-dsl build manifest for keiro-dsl/test/fixtures/process-reactions-minimal.keiro+-- Paste the complete fragment below into the consuming Cabal stanza.+-- The generated layer is overwritten on every scaffold; hole modules are+-- create-if-absent (filled by hand).++default-language: GHC2024+default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings++other-modules:+    Generated.ProcessReactionsMinimal.BehaviorSourceMap+    Generated.ProcessReactionsMinimal.Incident.BehaviorContract+    Generated.ProcessReactionsMinimal.Incident.Codec+    Generated.ProcessReactionsMinimal.Incident.Domain+    Generated.ProcessReactionsMinimal.Incident.EventStream+    Generated.ProcessReactionsMinimal.Incident.Harness+    Generated.ProcessReactionsMinimal.Incident.Projection+    Generated.ProcessReactionsMinimal.Incident.Transducer+    Generated.ProcessReactionsMinimal.IncidentReaction.Input+    Generated.ProcessReactionsMinimal.IncidentReaction.Process+    Generated.ProcessReactionsMinimal.IncidentSaga.BehaviorContract+    Generated.ProcessReactionsMinimal.IncidentSaga.Codec+    Generated.ProcessReactionsMinimal.IncidentSaga.Domain+    Generated.ProcessReactionsMinimal.IncidentSaga.EventStream+    Generated.ProcessReactionsMinimal.IncidentSaga.Harness+    Generated.ProcessReactionsMinimal.IncidentSaga.Projection+    Generated.ProcessReactionsMinimal.IncidentSaga.Transducer+    Generated.ProcessReactionsMinimal.Nominals+    Generated.ProcessReactionsMinimal.Nominals.Internal+    Generated.ProcessReactionsMinimal.ReplayAudit+    ProcessReactionsMinimal.Incident.BehaviorHoles+    ProcessReactionsMinimal.IncidentReaction.ProcessHoles+    ProcessReactionsMinimal.IncidentSaga.BehaviorHoles++build-depends:+    , aeson+    , base+    , keiki+    , keiro+    , shibuya-core+    , text+    , time+    , uuid
+ test/conformance-process-reactions/keiro-dsl-cabal-fragment.context.process-reactions.txt view
@@ -0,0 +1,55 @@+-- keiro-dsl build manifest for keiro-dsl/test/fixtures/process-reactions.keiro+-- Paste the complete fragment below into the consuming Cabal stanza.+-- The generated layer is overwritten on every scaffold; hole modules are+-- create-if-absent (filled by hand).++default-language: GHC2024+default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings++other-modules:+    Generated.ProcessReactions.AuditOnly.Input+    Generated.ProcessReactions.AuditOnly.Process+    Generated.ProcessReactions.AuditOnly.ProcessHarness+    Generated.ProcessReactions.BehaviorSourceMap+    Generated.ProcessReactions.Incident.BehaviorContract+    Generated.ProcessReactions.Incident.Codec+    Generated.ProcessReactions.Incident.Domain+    Generated.ProcessReactions.Incident.EventStream+    Generated.ProcessReactions.Incident.Harness+    Generated.ProcessReactions.Incident.Projection+    Generated.ProcessReactions.Incident.Transducer+    Generated.ProcessReactions.IncidentReaction.Input+    Generated.ProcessReactions.IncidentReaction.Process+    Generated.ProcessReactions.IncidentReaction.ProcessHarness+    Generated.ProcessReactions.IncidentSaga.BehaviorContract+    Generated.ProcessReactions.IncidentSaga.Codec+    Generated.ProcessReactions.IncidentSaga.Domain+    Generated.ProcessReactions.IncidentSaga.EventStream+    Generated.ProcessReactions.IncidentSaga.Harness+    Generated.ProcessReactions.IncidentSaga.Projection+    Generated.ProcessReactions.IncidentSaga.Transducer+    Generated.ProcessReactions.Nominals+    Generated.ProcessReactions.Nominals.Internal+    Generated.ProcessReactions.ReplayAudit+    Generated.ProcessReactions.ScalingReaction.Input+    Generated.ProcessReactions.ScalingReaction.Process+    Generated.ProcessReactions.ScalingReaction.ProcessHarness+    ProcessReactions.AuditOnly.ProcessHoles+    ProcessReactions.Incident.BehaviorHoles+    ProcessReactions.IncidentReaction.ProcessHoles+    ProcessReactions.IncidentSaga.BehaviorHoles+    ProcessReactions.ScalingReaction.ProcessHoles++build-depends:+    , aeson+    , base+    , keiki+    , keiro+    , shibuya-core+    , text+    , time+    , uuid
+ test/conformance-process-reactions/keiro-dsl-ledger.context.process-reactions.txt view
@@ -0,0 +1,81 @@+keiro-dsl scaffold record v1+spec: keiro-dsl/test/fixtures/process-reactions.keiro+module-root: (none)+layout: prefixed+source-language {"declaredLanguageVersion":6,"effectiveLanguageVersion":6,"sourceForm":"declared"}+semantic-contract {"languageSupport":"candidate","languageVersion":6,"runtimeSemantics":"keiro-dsl/runtime-semantics/5"}+naming-edition idiomatic-v2+module-role {"family":"BehaviorSourceMap","kind":"generated","ownerKind":"context","ownerName":"context process-reactions behavior source map","path":"Generated/ProcessReactions/BehaviorSourceMap.hs"}+module-role {"family":"Nominals","kind":"generated","ownerKind":"context","ownerName":"context process-reactions generated nominal declarations","path":"Generated/ProcessReactions/Nominals.hs"}+module-role {"family":"Internal","kind":"generated","ownerKind":"context","ownerName":"context process-reactions generated nominal ID internals","path":"Generated/ProcessReactions/Nominals/Internal.hs"}+module-role {"family":"ReplayAudit","kind":"generated","ownerKind":"context","ownerName":"context process-reactions replay-audit assembly","path":"Generated/ProcessReactions/ReplayAudit.hs"}+module-role {"family":"Input","kind":"generated","ownerKind":"process","ownerName":"process input IncidentReaction (line 7)","path":"Generated/ProcessReactions/IncidentReaction/Input.hs"}+module-role {"family":"Process","kind":"generated","ownerKind":"process","ownerName":"process reaction IncidentReaction (line 7)","path":"Generated/ProcessReactions/IncidentReaction/Process.hs"}+module-role {"family":"ProcessHoles","kind":"hole","ownerKind":"process","ownerName":"process decoder IncidentReaction (line 7)","path":"ProcessReactions/IncidentReaction/ProcessHoles.hs"}+module-role {"family":"ProcessHarness","kind":"generated","ownerKind":"process","ownerName":"process IncidentReaction (line 7)","path":"Generated/ProcessReactions/IncidentReaction/ProcessHarness.hs"}+module-role {"family":"Input","kind":"generated","ownerKind":"process","ownerName":"process input AuditOnly (line 32)","path":"Generated/ProcessReactions/AuditOnly/Input.hs"}+module-role {"family":"Process","kind":"generated","ownerKind":"process","ownerName":"process reaction AuditOnly (line 32)","path":"Generated/ProcessReactions/AuditOnly/Process.hs"}+module-role {"family":"ProcessHoles","kind":"hole","ownerKind":"process","ownerName":"process decoder AuditOnly (line 32)","path":"ProcessReactions/AuditOnly/ProcessHoles.hs"}+module-role {"family":"ProcessHarness","kind":"generated","ownerKind":"process","ownerName":"process AuditOnly (line 32)","path":"Generated/ProcessReactions/AuditOnly/ProcessHarness.hs"}+module-role {"family":"Input","kind":"generated","ownerKind":"process","ownerName":"process input ScalingReaction (line 46)","path":"Generated/ProcessReactions/ScalingReaction/Input.hs"}+module-role {"family":"Process","kind":"generated","ownerKind":"process","ownerName":"process reaction ScalingReaction (line 46)","path":"Generated/ProcessReactions/ScalingReaction/Process.hs"}+module-role {"family":"ProcessHoles","kind":"hole","ownerKind":"process","ownerName":"process decoder ScalingReaction (line 46)","path":"ProcessReactions/ScalingReaction/ProcessHoles.hs"}+module-role {"family":"ProcessHarness","kind":"generated","ownerKind":"process","ownerName":"process ScalingReaction (line 46)","path":"Generated/ProcessReactions/ScalingReaction/ProcessHarness.hs"}+module-role {"family":"Domain","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 754)","path":"Generated/ProcessReactions/IncidentSaga/Domain.hs"}+module-role {"family":"Codec","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 754)","path":"Generated/ProcessReactions/IncidentSaga/Codec.hs"}+module-role {"family":"Transducer","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 754)","path":"Generated/ProcessReactions/IncidentSaga/Transducer.hs"}+module-role {"family":"BehaviorContract","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 754)","path":"Generated/ProcessReactions/IncidentSaga/BehaviorContract.hs"}+module-role {"family":"BehaviorHoles","kind":"hole","ownerKind":"aggregate","ownerName":"aggregate behavior witnesses IncidentSaga (line 754)","path":"ProcessReactions/IncidentSaga/BehaviorHoles.hs"}+module-role {"family":"EventStream","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 754)","path":"Generated/ProcessReactions/IncidentSaga/EventStream.hs"}+module-role {"family":"Projection","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 754)","path":"Generated/ProcessReactions/IncidentSaga/Projection.hs"}+module-role {"family":"Harness","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 754)","path":"Generated/ProcessReactions/IncidentSaga/Harness.hs"}+module-role {"family":"Domain","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 764)","path":"Generated/ProcessReactions/Incident/Domain.hs"}+module-role {"family":"Codec","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 764)","path":"Generated/ProcessReactions/Incident/Codec.hs"}+module-role {"family":"Transducer","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 764)","path":"Generated/ProcessReactions/Incident/Transducer.hs"}+module-role {"family":"BehaviorContract","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 764)","path":"Generated/ProcessReactions/Incident/BehaviorContract.hs"}+module-role {"family":"BehaviorHoles","kind":"hole","ownerKind":"aggregate","ownerName":"aggregate behavior witnesses Incident (line 764)","path":"ProcessReactions/Incident/BehaviorHoles.hs"}+module-role {"family":"EventStream","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 764)","path":"Generated/ProcessReactions/Incident/EventStream.hs"}+module-role {"family":"Projection","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 764)","path":"Generated/ProcessReactions/Incident/Projection.hs"}+module-role {"family":"Harness","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 764)","path":"Generated/ProcessReactions/Incident/Harness.hs"}+generated Generated/ProcessReactions/BehaviorSourceMap.hs+generated Generated/ProcessReactions/Nominals.hs+generated Generated/ProcessReactions/Nominals/Internal.hs+generated Generated/ProcessReactions/ReplayAudit.hs+generated Generated/ProcessReactions/IncidentReaction/Input.hs+generated Generated/ProcessReactions/IncidentReaction/Process.hs+hole ProcessReactions/IncidentReaction/ProcessHoles.hs+generated Generated/ProcessReactions/IncidentReaction/ProcessHarness.hs+generated Generated/ProcessReactions/AuditOnly/Input.hs+generated Generated/ProcessReactions/AuditOnly/Process.hs+hole ProcessReactions/AuditOnly/ProcessHoles.hs+generated Generated/ProcessReactions/AuditOnly/ProcessHarness.hs+generated Generated/ProcessReactions/ScalingReaction/Input.hs+generated Generated/ProcessReactions/ScalingReaction/Process.hs+hole ProcessReactions/ScalingReaction/ProcessHoles.hs+generated Generated/ProcessReactions/ScalingReaction/ProcessHarness.hs+generated Generated/ProcessReactions/IncidentSaga/Domain.hs+generated Generated/ProcessReactions/IncidentSaga/Codec.hs+generated Generated/ProcessReactions/IncidentSaga/Transducer.hs+generated Generated/ProcessReactions/IncidentSaga/BehaviorContract.hs+hole ProcessReactions/IncidentSaga/BehaviorHoles.hs+generated Generated/ProcessReactions/IncidentSaga/EventStream.hs+generated Generated/ProcessReactions/IncidentSaga/Projection.hs+generated Generated/ProcessReactions/IncidentSaga/Harness.hs+generated Generated/ProcessReactions/Incident/Domain.hs+generated Generated/ProcessReactions/Incident/Codec.hs+generated Generated/ProcessReactions/Incident/Transducer.hs+generated Generated/ProcessReactions/Incident/BehaviorContract.hs+hole ProcessReactions/Incident/BehaviorHoles.hs+generated Generated/ProcessReactions/Incident/EventStream.hs+generated Generated/ProcessReactions/Incident/Projection.hs+generated Generated/ProcessReactions/Incident/Harness.hs+id-domain id-domain|name=IncidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text+nominal-equality nominal-equality|name=IncidentId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:inc:keiro-dsl/id-domain/typeid-v7/1|owner=generated+nominal-equality nominal-equality|name=Severity|contract=keiro-dsl/nominal-equality/1|key=Text|domain=finite-text:sev1,sev2|owner=generated+behavior {"aggregate":"Incident","command":"EscalateIncident","evidence":"generated-authoritative","key":"behavior-v1-4126b087f05aadf6","kind":"live-transition","outputs":[{"command":"EscalateIncident","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"IncidentSaga","command":"RecordCritical","evidence":"generated-authoritative","key":"behavior-v1-6b66722f9f2463d3","kind":"live-transition","outputs":[{"command":"RecordCritical","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"IncidentSaga","command":"RecordRoutine","evidence":"generated-authoritative","key":"behavior-v1-825e6c1709cb63b4","kind":"live-transition","outputs":[{"command":"RecordRoutine","ownership":"generated-command-identity"}],"source":"Open"}+process-reaction {"fingerprint":"dff4a685084373ac102b8fa9591bc4cdbaa358a19bdec488ea157bd038421573","holeObligations":["decodeIncidentReactionInput :: RecordedEvent -> Maybe IncidentReactionInput"],"processName":"incident-reaction","verification":"generated-declarative","version":1}+process-reaction {"fingerprint":"a98c341339b007c1e28edff6a1a89b91a9dd3ac63c83bfe57e6b41479d84af96","holeObligations":["decodeAuditOnlyInput :: RecordedEvent -> Maybe AuditOnlyInput"],"processName":"audit-only","verification":"generated-declarative","version":1}+process-reaction {"fingerprint":"8329eab62dfa1917a468c914b9bbb7cae121b5d353656e69543f6aa95a43a14f","holeObligations":["decodeScalingReactionInput :: RecordedEvent -> Maybe ScalingReactionInput"],"processName":"scaling-reaction","verification":"generated-declarative","version":1}+semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
test/conformance-process-runtime/Generated/HospitalCapacity/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context hospital-capacity behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context hospital-capacity behavior source map; do not edit. module Generated.HospitalCapacity.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/BehaviorContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Codec (     hospitalCodec,     parseHospitalEvent,
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Domain where  import GHC.Generics (Generic)
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.EventStream   ( hospitalCategory   , hospitalCommandCategory
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Harness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Harness (harnessAssertions) where  import Generated.HospitalCapacity.Hospital.Domain
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Transducer   ( hospitalTransducer   , hospitalFoldFingerprint
test/conformance-process-runtime/Generated/HospitalCapacity/HospitalSurge/Process.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from process HospitalSurge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from process HospitalSurge; do not edit. module Generated.HospitalCapacity.HospitalSurge.Process   ( hospitalSurgeProcessName   , hospitalSurgeCategory
test/conformance-process-runtime/Generated/HospitalCapacity/HospitalSurge/ProcessHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from process HospitalSurge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from process HospitalSurge; do not edit. module Generated.HospitalCapacity.HospitalSurge.ProcessHarness (processHarnessValues) where  -- | (label, value): the spec's deterministic process/timer decisions,
test/conformance-process-runtime/Generated/HospitalCapacity/Nominals.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal declarations; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal declarations; do not edit. module Generated.HospitalCapacity.Nominals   ( CommandId   , parseCommandId
test/conformance-process-runtime/Generated/HospitalCapacity/Nominals/Internal.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal ID internals; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal ID internals; do not edit. module Generated.HospitalCapacity.Nominals.Internal   ( CommandId   , parseCommandId
test/conformance-process-runtime/Generated/HospitalCapacity/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context hospital-capacity replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context hospital-capacity replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/BehaviorContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Codec (     surgeCodec,     parseSurgeEvent,
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Domain where  import Data.Text (Text)
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.EventStream   ( surgeCategory   , surgeCommandCategory
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Harness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Harness (harnessAssertions) where  import Generated.HospitalCapacity.Surge.Domain
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Transducer   ( surgeTransducer   , surgeFoldFingerprint
test/conformance-process-runtime/keiro-dsl-ledger.context.hospital-capacity.txt view
@@ -58,4 +58,5 @@ behavior {"aggregate":"Surge","command":"NoteSurgeThreshold","evidence":"generated-authoritative","key":"behavior-v1-5198a253324042e6","kind":"live-transition","outputs":[{"command":"NoteSurgeThreshold","ownership":"generated-command-identity"}],"source":"Idle"} behavior {"aggregate":"Surge","command":"MarkSurgeTimerFired","evidence":"generated-authoritative","key":"behavior-v1-6721e0b61aa38780","kind":"live-transition","outputs":[{"command":"MarkSurgeTimerFired","ownership":"generated-command-identity"}],"source":"Idle"} behavior {"aggregate":"Hospital","command":"ActivateSurge","evidence":"generated-authoritative","key":"behavior-v1-69ac3daa8569d350","kind":"live-transition","outputs":[{"command":"ActivateSurge","ownership":"generated-command-identity"}],"source":"Operational"}+process-reaction {"fingerprint":null,"holeObligations":[],"processName":"hospital-surge","verification":"custom-unverified","version":null} semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
+ test/conformance-process-state-authority/Generated/IncidentResponse/BehaviorSourceMap.hs view
@@ -0,0 +1,38 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context incident-response behavior source map; do not edit.+module Generated.IncidentResponse.BehaviorSourceMap+  ( BehaviorSourceLocation (..)+  , behaviorSourceLocation+  , renderBehaviorSourceLocation+  ) where++import Data.Text (Text)+import Data.Text qualified as T++data BehaviorSourceLocation = BehaviorSourceLocation+  { file :: !FilePath+  , line :: !Int+  , column :: !Int+  }+  deriving stock (Eq, Ord, Show)++behaviorSourceLocation :: Text -> Maybe BehaviorSourceLocation+behaviorSourceLocation key = case key of+  "behavior-v1-00b0b13023eea6f8" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 81 3)+  "behavior-v1-0aad69728dee8fec" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 97 3)+  "behavior-v1-16209316858bb8c3" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 65 15)+  "behavior-v1-2144226ce8222855" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 73 3)+  "behavior-v1-36c541281e30554e" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 96 3)+  "behavior-v1-3d0e024503e32404" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 84 3)+  "behavior-v1-65795e7a28345559" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 77 3)+  "behavior-v1-75011409d18e29c3" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 65 15)+  "behavior-v1-8f58f8301e7a66f3" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 65 15)+  "behavior-v1-eecae8fa281fddcf" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-state-authority.keiro" 65 15)+  _ -> Nothing++renderBehaviorSourceLocation :: Text -> Text+renderBehaviorSourceLocation key = case behaviorSourceLocation key of+  Just location -> T.pack location.file <> ":" <> tshow location.line <> ":" <> tshow location.column+  Nothing -> "<internal invariant: missing behavior source for " <> key <> ">"++tshow :: Show value => value -> Text+tshow = T.pack . show
+ test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/BehaviorContract.hs view
@@ -0,0 +1,451 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Escalation; do not edit.+module Generated.IncidentResponse.Escalation.BehaviorContract+  ( BehaviorKey (..)+  , unBehaviorKey+  , ObligationKind (..)+  , EvidenceLevel (..)+  , GuardCoverage (..)+  , BehaviorRequirement (..)+  , RejectionClass (..)+  , LiveExpectation (..)+  , BehaviorWitness (..)+  , BehaviorFailure (..)+  , BehaviorConformanceReport (..)+  , behaviorRequirements+  , behaviorCoverageReport+  , behaviorConformancePassed+  , behaviorConformancePassedWith+  , renderBehaviorConformanceText+  ) where++import Generated.IncidentResponse.Escalation.Codec (encodeEscalationEvent, parseEscalationEvent, escalationCodec)+import Generated.IncidentResponse.Escalation.Domain+import Generated.IncidentResponse.Escalation.Transducer (escalationTransducer)+import Generated.IncidentResponse.BehaviorSourceMap qualified as BehaviorSourceMap+import Generated.IncidentResponse.Escalation.EventStream (escalationDomainCommandHandler)+import Generated.IncidentResponse.Nominals (EscalationNoOp, EscalationRejection)+import Keiro.Command (DomainCommandHandler (..), SilentCommandContext (..), SilentDomainDecision (..))+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 (EdgeMode (..), EdgeRef (..), RegFile, ReplayAttribution (..), ReplayEventSpan (..), ReplaySuccess (..), StepFailure (..), StepSuccess (..), applyEventsDetailedEither, stepDetailedEither)+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+  { key :: !BehaviorKey+  , kind :: !ObligationKind+  , evidence :: !EvidenceLevel+  , guardCoverage :: !GuardCoverage+  , source :: !EscalationVertex+  , commandName :: !Text+  , expectedEdge :: !(Maybe (K.EdgeRef EscalationVertex))+  , target :: !(Maybe EscalationVertex)+  , eventKinds :: ![Text]+  }+  deriving stock (Eq, Show)++data RejectionClass = RejectNoOutgoingEdges | RejectNoMatchingEdge+  deriving stock (Eq, Show)++data LiveExpectation+  = Emits (NonEmpty EscalationEvent)+  | Rejects RejectionClass+  | RejectedWith EscalationRejection+  | NoOpWith EscalationNoOp+  | NoOp+  deriving stock (Eq, Show)++data BehaviorWitness+  = Pending BehaviorKey+  | LiveWitness+      { key :: BehaviorKey+      , history :: [EscalationEvent]+      , command :: EscalationCommand+      , expected :: LiveExpectation+      }+  | ReplayWitness+      { key :: BehaviorKey+      , historyPrefix :: [EscalationEvent]+      , observedChunk :: [EscalationEvent]+      }+  deriving stock (Eq, Show)++data BehaviorFailure = BehaviorFailure+  { key :: !BehaviorKey+  , subject :: !Text+  , code :: !Text+  , detail :: !Text+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorFailure where+  toJSON behaviorFailure = object+    [ "key" .= unBehaviorKey behaviorFailure.key+    , "subject" .= behaviorFailure.subject+    , "code" .= behaviorFailure.code+    , "detail" .= behaviorFailure.detail+    ]++data BehaviorConformanceReport = BehaviorConformanceReport+  { required :: ![BehaviorKey]+  , filled :: ![BehaviorKey]+  , pending :: ![BehaviorKey]+  , missing :: ![BehaviorKey]+  , duplicate :: ![BehaviorKey]+  , stale :: ![BehaviorKey]+  , failed :: ![BehaviorFailure]+  , verified :: ![BehaviorKey]+  , unverified :: ![BehaviorKey]+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorConformanceReport where+  toJSON report = object+    [ "schema" .= ("keiro/behavior-conformance/1" :: Text)+    , "required" .= keyTexts report.required+    , "filled" .= keyTexts report.filled+    , "pending" .= keyTexts report.pending+    , "missing" .= keyTexts report.missing+    , "duplicate" .= keyTexts report.duplicate+    , "stale" .= keyTexts report.stale+    , "failed" .= report.failed+    , "verified" .= keyTexts report.verified+    , "unverified" .= keyTexts report.unverified+    ]++behaviorRequirements :: [BehaviorRequirement]+behaviorRequirements =+  [ -- EscalationOpen x NoteIgnored: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-00b0b13023eea6f8"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = EscalationOpen+      , commandName = "NoteIgnored"+      , expectedEdge = (Just (K.EdgeRef EscalationOpen 2))+      , target = Just EscalationOpen+      , eventKinds = []+      }+  , -- EscalationDormant x NoteAcknowledged: required rejection+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-16209316858bb8c3"+      , kind = RequiredRejection+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardNotApplicable+      , source = EscalationDormant+      , commandName = "NoteAcknowledged"+      , expectedEdge = Nothing+      , target = Nothing+      , eventKinds = []+      }+  , -- EscalationOpen x NoteRaised: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-2144226ce8222855"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = EscalationOpen+      , commandName = "NoteRaised"+      , expectedEdge = (Just (K.EdgeRef EscalationOpen 0))+      , target = Just EscalationOpen+      , eventKinds = ["RaisedNoted"]+      }+  , -- EscalationOpen x ActivateDormant: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-3d0e024503e32404"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = EscalationOpen+      , commandName = "ActivateDormant"+      , expectedEdge = (Just (K.EdgeRef EscalationOpen 3))+      , target = Just EscalationDormant+      , eventKinds = ["DormantActivated"]+      }+  , -- EscalationOpen x NoteAcknowledged: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-65795e7a28345559"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = EscalationOpen+      , commandName = "NoteAcknowledged"+      , expectedEdge = (Just (K.EdgeRef EscalationOpen 1))+      , target = Just EscalationOpen+      , eventKinds = ["Acknowledged"]+      }+  , -- EscalationDormant x NoteRaised: required rejection+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-75011409d18e29c3"+      , kind = RequiredRejection+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardNotApplicable+      , source = EscalationDormant+      , commandName = "NoteRaised"+      , expectedEdge = Nothing+      , target = Nothing+      , eventKinds = []+      }+  , -- EscalationDormant x ActivateDormant: required rejection+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-8f58f8301e7a66f3"+      , kind = RequiredRejection+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardNotApplicable+      , source = EscalationDormant+      , commandName = "ActivateDormant"+      , expectedEdge = Nothing+      , target = Nothing+      , eventKinds = []+      }+  , -- EscalationDormant x NoteIgnored: required rejection+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-eecae8fa281fddcf"+      , kind = RequiredRejection+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardNotApplicable+      , source = EscalationDormant+      , commandName = "NoteIgnored"+      , expectedEdge = Nothing+      , target = Nothing+      , eventKinds = []+      }+  ]++behaviorCoverageReport :: [BehaviorWitness] -> BehaviorConformanceReport+behaviorCoverageReport witnesses =+  BehaviorConformanceReport+    { required = sortedKeys (Map.keys requiredByKey)+    , filled = sortedKeys [key | (key, [witness]) <- Map.toList witnessGroups, Map.member key requiredByKey, not (isPending witness)]+    , pending = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, Map.member key requiredByKey, any isPending rows]+    , missing = sortedKeys [key | key <- Map.keys requiredByKey, Map.notMember key witnessGroups]+    , duplicate = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, length rows > 1]+    , stale = sortedKeys [key | key <- Map.keys witnessGroups, Map.notMember key requiredByKey]+    , failed = sortOn (unBehaviorKey . (.key)) failures+    , verified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, proofStrength requirement]+    , unverified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, not (proofStrength requirement)]+    }+ where+  requiredByKey = Map.fromList [(requirement.key, 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.pending+    && null report.missing+    && null report.duplicate+    && null report.stale+    && null report.failed+    && (not failOnUnverified || null report.unverified)++renderBehaviorConformanceText :: BehaviorConformanceReport -> Text+renderBehaviorConformanceText report = T.unlines+  [ "behavior conformance: Escalation"+  , "schema: keiro/behavior-conformance/1"+  , countLine "required" report.required+  , countLine "filled" report.filled+  , countLine "pending" report.pending+  , countLine "missing" report.missing+  , countLine "duplicate" report.duplicate+  , countLine "stale" report.stale+  , "failed: " <> tshow (length report.failed)+  , countLine "verified" report.verified+  , countLine "unverified" report.unverified+  ] <> T.unlines ["FAIL " <> unBehaviorKey behaviorFailure.key <> " " <> behaviorFailure.subject <> " [" <> behaviorFailure.code <> "] " <> behaviorFailure.detail | behaviorFailure <- report.failed]++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 -> [EscalationEvent] -> EscalationCommand -> LiveExpectation -> Either BehaviorFailure ()+runLive requirement history command expectation = do+  settled <- settleHistory requirement "history" history+  ensure requirement (K.replaySuccessState settled == requirement.source) "history-wrong-source" "history does not settle at the required source vertex"+  ensure requirement (commandKind command == requirement.commandName) "command-mismatch" "witness command constructor does not match the required state/command cell"+  case requirement.kind 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 -> (EscalationVertex, K.RegFile EscalationRegs) -> EscalationCommand -> LiveExpectation -> Either BehaviorFailure ()+runRejection requirement seed command expectation = case expectation of+  Emits _ -> failure requirement "expectation-kind" "a rejection requirement cannot expect emitted events"+  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"+  NoOp -> failure requirement "expectation-kind" "a rejection requirement cannot expect an accepted no-op"+  Rejects expectedClass -> case K.stepDetailedEither escalationTransducer 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 -> (EscalationVertex, K.RegFile EscalationRegs) -> EscalationCommand -> LiveExpectation -> Either BehaviorFailure ()+runAcceptance requirement seed command expectation = case expectation of+  Rejects _ -> failure requirement "expectation-kind" "a live-transition requirement needs Emits or NoOp"+  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)+  NoOp -> failure requirement "expectation-kind" "an outcome-enabled transition requires RejectedWith or NoOpWith exact reason evidence"+  Emits expectedEvents -> case K.stepDetailedEither escalationTransducer 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.eventKinds) "event-envelope-mismatch" ("runtime event kinds differ from the declared ordered envelope; actual=" <> tshow (map eventKind actual) <> " expected=" <> tshow requirement.eventKinds)+      decoded <- either (failure requirement "emitted-codec-decode") Right (decodeEvents actual)+      replayed <- case K.applyEventsDetailedEither escalationTransducer 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)++runSilentDecision+  :: BehaviorRequirement+  -> (EscalationVertex, K.RegFile EscalationRegs)+  -> EscalationCommand+  -> Either BehaviorFailure (SilentDomainDecision EscalationRejection EscalationNoOp)+runSilentDecision requirement seed command = case K.stepDetailedEither escalationTransducer 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 escalationDomainCommandHandler of+      DomainCommandHandler _ classify ->+        Right (classify (SilentCommandContext (fst seed) (snd seed) command (K.stepSuccessEdge success)))++checkAcceptedEnvelope :: BehaviorRequirement -> K.StepSuccess EscalationRegs EscalationVertex EscalationEvent -> 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.expectedEdge) "edge-attribution" ("runtime selected a different guarded sibling; actual=" <> tshow (Just (K.stepSuccessEdge success)) <> " expected=" <> tshow requirement.expectedEdge)+  ensure requirement (Just (K.stepSuccessState success) == requirement.target) "target-mismatch" ("runtime reached a different target vertex; actual=" <> tshow (Just (K.stepSuccessState success)) <> " expected=" <> tshow requirement.target)++runReplay :: BehaviorRequirement -> [EscalationEvent] -> [EscalationEvent] -> Either BehaviorFailure ()+runReplay requirement prefix chunk = case requirement.kind of+  ReplayTransition -> do+    settled <- settleHistory requirement "history-prefix" prefix+    ensure requirement (K.replaySuccessState settled == requirement.source) "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 escalationTransducer (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.target) "target-mismatch" ("replay chunk reached a different target vertex; actual=" <> tshow (Just (K.replaySuccessState replayed)) <> " expected=" <> tshow requirement.target)+    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 EscalationVertex] -> Either BehaviorFailure ()+checkSingleAttribution requirement expectedMode eventCount trace = case trace of+  [attribution] -> do+    ensure requirement (Just (K.replayAttributionEdge attribution) == requirement.expectedEdge) "replay-edge-attribution" ("replay selected a different edge; actual=" <> tshow (Just (K.replayAttributionEdge attribution)) <> " expected=" <> tshow requirement.expectedEdge)+    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.source) "replay-source-attribution" ("replay attribution starts at the wrong source; actual=" <> tshow (K.replayAttributionSource attribution) <> " expected=" <> tshow requirement.source)+    ensure requirement (Just (K.replayAttributionTarget attribution) == requirement.target) "replay-target-attribution" ("replay attribution ends at the wrong target; actual=" <> tshow (Just (K.replayAttributionTarget attribution)) <> " expected=" <> tshow requirement.target)+    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 -> [EscalationEvent] -> Either BehaviorFailure (K.ReplaySuccess EscalationRegs EscalationVertex)+settleHistory requirement label history = do+  decoded <- either (failure requirement (label <> "-codec-decode")) Right (decodeEvents history)+  case K.applyEventsDetailedEither escalationTransducer (EscalationOpen, initialEscalationRegs) decoded of+    Left replayFailure -> failure requirement (label <> "-replay-failed") (tshow replayFailure)+    Right replaySuccess -> Right replaySuccess++decodeEvents :: [EscalationEvent] -> Either Text [EscalationEvent]+decodeEvents = traverse (\event -> parseEscalationEvent (Codec.eventType escalationCodec event) (encodeEscalationEvent event))++commandKind :: EscalationCommand -> Text+commandKind command = case command of+  NoteRaised _ -> "NoteRaised"+  NoteAcknowledged _ -> "NoteAcknowledged"+  NoteIgnored _ -> "NoteIgnored"+  ActivateDormant _ -> "ActivateDormant"++eventKind :: EscalationEvent -> Text+eventKind event = case Codec.eventType escalationCodec event of Codec.EventType tag -> tag++regsEqual :: K.RegFile EscalationRegs -> K.RegFile EscalationRegs -> Bool+regsEqual _ _ = True++proofStrength :: BehaviorRequirement -> Bool+proofStrength requirement =+  requirement.evidence == GeneratedAuthoritative+    && requirement.guardCoverage `elem` [GuardTotal, GuardNotApplicable]++behaviorWitnessKey :: BehaviorWitness -> BehaviorKey+behaviorWitnessKey witness = case witness of+  Pending key -> key+  LiveWitness { key = key } -> key+  ReplayWitness { key = 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.key+        (tshow requirement.source <> " x " <> requirement.commandName <> ": " <> kindPhrase <> " (" <> BehaviorSourceMap.renderBehaviorSourceLocation (unBehaviorKey requirement.key) <> ")")+        code+        detail+    )+ where+  kindPhrase = case requirement.kind 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
+ test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/Codec.hs view
@@ -0,0 +1,88 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Escalation; do not edit.+module Generated.IncidentResponse.Escalation.Codec (+    escalationCodec,+    parseEscalationEvent,+    encodeEscalationEvent,+) where++import Generated.IncidentResponse.Escalation.Domain+import Generated.IncidentResponse.Nominals (incidentIdText)+import Generated.IncidentResponse.Nominals.Internal (unsafeIncidentIdFromLegacyText)+import Data.Aeson (Value, object, withObject, (.:), (.=))+import Data.Aeson.Types (parseEither)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text (Text)+import qualified Data.Text as T+import Keiro.Codec (Codec (..), EventType (..))++++++escalationEventTypes :: NonEmpty EventType+escalationEventTypes = EventType "RaisedNoted" :| [EventType "Acknowledged", EventType "DormantActivated"]++escalationCodec :: Codec EscalationEvent+escalationCodec =+  Codec+    { eventTypes = escalationEventTypes+    , eventType = \case+        RaisedNoted{} -> EventType "RaisedNoted"+        Acknowledged{} -> EventType "Acknowledged"+        DormantActivated{} -> EventType "DormantActivated"+    , schemaVersion = 1+    , encode = encodeEscalationEvent+    , decode = parseEscalationEvent+    , upcasters = []+    }++encodeEscalationEvent :: EscalationEvent -> Value+encodeEscalationEvent = \case+  RaisedNoted payload ->+    object+      [ "kind" .= ("RaisedNoted" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]+  Acknowledged payload ->+    object+      [ "kind" .= ("Acknowledged" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]+  DormantActivated payload ->+    object+      [ "kind" .= ("DormantActivated" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]++parseEscalationEvent :: EventType -> Value -> Either Text EscalationEvent+parseEscalationEvent (EventType tag) = mapLeftText . parseEither (withObject "EscalationEvent" go)+  where+    go o = do+      case tag of+        "RaisedNoted" ->+          RaisedNoted+            <$> ( RaisedNotedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        "Acknowledged" ->+          Acknowledged+            <$> ( AcknowledgedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        "DormantActivated" ->+          DormantActivated+            <$> ( DormantActivatedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes escalationEventTypes)++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
+ test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/Domain.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TemplateHaskell #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Escalation; do not edit.+module Generated.IncidentResponse.Escalation.Domain where++import GHC.Generics (Generic)+import Keiki.Core (RegFile (..))+import Generated.IncidentResponse.Nominals (IncidentId)+import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)++data EscalationVertex = EscalationOpen | EscalationDormant+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)++data NoteRaisedData = NoteRaisedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data NoteAcknowledgedData = NoteAcknowledgedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data NoteIgnoredData = NoteIgnoredData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data ActivateDormantData = ActivateDormantData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data EscalationCommand = NoteRaised !NoteRaisedData+  | NoteAcknowledged !NoteAcknowledgedData+  | NoteIgnored !NoteIgnoredData+  | ActivateDormant !ActivateDormantData+  deriving stock (Generic, Eq, Show)++data RaisedNotedData = RaisedNotedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data AcknowledgedData = AcknowledgedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data DormantActivatedData = DormantActivatedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data EscalationEvent = RaisedNoted !RaisedNotedData+  | Acknowledged !AcknowledgedData+  | DormantActivated !DormantActivatedData+  deriving stock (Generic, Eq, Show)++type EscalationRegs =+  '[]++initialEscalationRegs :: RegFile EscalationRegs+initialEscalationRegs =+  RNil++$(deriveAggregateCtorsAll ''EscalationCommand ''EscalationRegs)++++$(deriveWireCtorsAll ''EscalationEvent)
+ test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/EventStream.hs view
@@ -0,0 +1,81 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Escalation; do not edit.+module Generated.IncidentResponse.Escalation.EventStream+  ( escalationCategory+  , escalationCommandCategory+  , escalationEventStream+  , escalationEventStreamDef+  , EscalationEventStream+  , EscalationEventStreamDef+  , escalationDomainCommandHandler+  ) where++import Generated.IncidentResponse.Escalation.Domain+import Generated.IncidentResponse.Escalation.Codec (escalationCodec)+import Generated.IncidentResponse.Escalation.Transducer (escalationTransducer)+import Generated.IncidentResponse.Nominals (EscalationNoOp (..), EscalationRejection (..))+import Keiki.Core (EdgeRef (..), HsPred)+import Keiki.Core qualified as K+import Keiro.Command (DomainCommandHandler (..), SilentCommandContext (..), SilentDomainDecision (..))+import Keiro.EventStream (EventStream (..), SnapshotPolicy (..))+import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow)+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.+escalationCategory :: Stream.StreamCategory EscalationEventStreamDef+escalationCategory = Stream.categoryUnsafe "escalation"++-- The same category text, typed for command envelopes such as PMCommand.+escalationCommandCategory :: Stream.StreamCategory EscalationCommand+escalationCommandCategory = Stream.categoryUnsafe "escalation"++type EscalationEventStreamDef =+  EventStream (HsPred EscalationRegs EscalationCommand) EscalationRegs EscalationVertex EscalationCommand EscalationEvent++type EscalationEventStream =+  ValidatedEventStream (HsPred EscalationRegs EscalationCommand) EscalationRegs EscalationVertex EscalationCommand EscalationEvent++escalationEventStreamDef :: EscalationEventStreamDef+escalationEventStreamDef =+  EventStream+    { transducer = escalationTransducer,+      initialState = EscalationOpen,+      initialRegisters = initialEscalationRegs,+      eventCodec = escalationCodec,+      resolveStreamName = Stream.streamName,+      snapshotPolicy = Never,+      stateCodec = Nothing+    }++escalationEventStream :: EscalationEventStream+escalationEventStream =+  mkEventStreamOrThrow "Escalation" escalationEventStreamDef++escalationDomainCommandHandler+  :: DomainCommandHandler+       (HsPred EscalationRegs EscalationCommand)+       EscalationRegs+       EscalationVertex+       EscalationCommand+       EscalationEvent+       EscalationRejection+       EscalationNoOp+escalationDomainCommandHandler =+  DomainCommandHandler escalationEventStream escalationSilentDecision++escalationSilentDecision+  :: SilentCommandContext EscalationRegs EscalationVertex EscalationCommand+  -> SilentDomainDecision+       EscalationRejection+       EscalationNoOp+escalationSilentDecision (SilentCommandContext _ registers command (EdgeRef edgeSource edgeIndex)) =+  case edgeSource of+    EscalationOpen ->+      case edgeIndex of+        2 -> SilentNoOp (K.evalTerm (K.lit Ignored) registers command)+        _ -> outcomeInvariant edgeSource edgeIndex+    _ -> outcomeInvariant edgeSource edgeIndex+ where+  outcomeInvariant source index =+    error ("generated domain outcome invariant failed for aggregate Escalation edge " <> show source <> "#" <> show index)
+ test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/Harness.hs view
@@ -0,0 +1,124 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Escalation; do not edit.+module Generated.IncidentResponse.Escalation.Harness (harnessAssertions) where++import Generated.IncidentResponse.Escalation.Domain+import Generated.IncidentResponse.Escalation.Codec (encodeEscalationEvent, parseEscalationEvent, escalationCodec)+import Generated.IncidentResponse.Escalation.Transducer (escalationTransducer)+import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)+import Keiro.Codec (eventType)+import Generated.IncidentResponse.Nominals (IncidentId, parseIncidentId)++-- | (label, passed). A driver runs these and exits non-zero on any False,+-- naming the failing assertion. Filling a hole wrongly turns a specific+-- entry False; the scaffold cannot.+harnessAssertions :: [(String, Bool)]+harnessAssertions =+  [ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions escalationTransducer))+  -- clock-free: spec samples no wall clock (verified at scaffold time)+  , ("golden round-trip: RaisedNoted", roundTrips sampleEventRaisedNoted)+  , ("golden round-trip: Acknowledged", roundTrips sampleEventAcknowledged)+  , ("golden round-trip: DormantActivated", roundTrips sampleEventDormantActivated)+  , ("accepts NoteRaised from EscalationOpen", acceptNoteRaised)+  , ("accepts NoteAcknowledged from EscalationOpen", acceptNoteAcknowledged)+  , ("accepts NoteIgnored from EscalationOpen", acceptNoteIgnored)+  , ("accepts ActivateDormant from EscalationOpen", acceptActivateDormant)+  ]+  ++ forwardReplayNoteRaised+  ++ forwardReplayNoteAcknowledged+  ++ forwardReplayActivateDormant++roundTrips :: EscalationEvent -> Bool+roundTrips e = parseEscalationEvent (eventType escalationCodec e) (encodeEscalationEvent e) == Right e++sampleIncidentId :: IncidentId+sampleIncidentId =+  case parseIncidentId "inc_01h455vb4pex5vsknk084sn02q" of+    Right parsed -> parsed+    Left problem -> error (show problem)++sampleEventRaisedNoted :: EscalationEvent+sampleEventRaisedNoted = RaisedNoted (RaisedNotedData sampleIncidentId)++sampleEventAcknowledged :: EscalationEvent+sampleEventAcknowledged = Acknowledged (AcknowledgedData sampleIncidentId)++sampleEventDormantActivated :: EscalationEvent+sampleEventDormantActivated = DormantActivated (DormantActivatedData sampleIncidentId)++acceptNoteRaised :: Bool+acceptNoteRaised =+  case step escalationTransducer (EscalationOpen, initialEscalationRegs) (NoteRaised (NoteRaisedData sampleIncidentId)) of+    Just (v, _, _) -> v == EscalationOpen+    Nothing -> False++acceptNoteAcknowledged :: Bool+acceptNoteAcknowledged =+  case step escalationTransducer (EscalationOpen, initialEscalationRegs) (NoteAcknowledged (NoteAcknowledgedData sampleIncidentId)) of+    Just (v, _, _) -> v == EscalationOpen+    Nothing -> False++acceptNoteIgnored :: Bool+acceptNoteIgnored =+  case step escalationTransducer (EscalationOpen, initialEscalationRegs) (NoteIgnored (NoteIgnoredData sampleIncidentId)) of+    Just (v, _, _) -> v == EscalationOpen+    Nothing -> False++acceptActivateDormant :: Bool+acceptActivateDormant =+  case step escalationTransducer (EscalationOpen, initialEscalationRegs) (ActivateDormant (ActivateDormantData sampleIncidentId)) of+    Just (v, _, _) -> v == EscalationDormant+    Nothing -> False++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayNoteRaised :: [(String, Bool)]+forwardReplayNoteRaised =+  case step escalationTransducer (EscalationOpen, initialEscalationRegs) (NoteRaised (NoteRaisedData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseEscalationEvent (eventType escalationCodec event) (encodeEscalationEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither escalationTransducer (EscalationOpen, initialEscalationRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: NoteRaised from EscalationOpen -- "++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayNoteAcknowledged :: [(String, Bool)]+forwardReplayNoteAcknowledged =+  case step escalationTransducer (EscalationOpen, initialEscalationRegs) (NoteAcknowledged (NoteAcknowledgedData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseEscalationEvent (eventType escalationCodec event) (encodeEscalationEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither escalationTransducer (EscalationOpen, initialEscalationRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: NoteAcknowledged from EscalationOpen -- "++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayActivateDormant :: [(String, Bool)]+forwardReplayActivateDormant =+  case step escalationTransducer (EscalationOpen, initialEscalationRegs) (ActivateDormant (ActivateDormantData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseEscalationEvent (eventType escalationCodec event) (encodeEscalationEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither escalationTransducer (EscalationOpen, initialEscalationRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: ActivateDormant from EscalationOpen -- "
+ test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/Projection.hs view
@@ -0,0 +1,4 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Escalation; do not edit.+module Generated.IncidentResponse.Escalation.Projection () where++-- No projection declarations are present; this module keeps the generated manifest inventory total.
+ test/conformance-process-state-authority/Generated/IncidentResponse/Escalation/Transducer.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE QualifiedDo #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Escalation; do not edit.+module Generated.IncidentResponse.Escalation.Transducer+  ( escalationTransducer+  , escalationFoldFingerprint+  , BehaviorOwnership (..)+  , escalationPredicateVerifications+  ) where++import Generated.IncidentResponse.Escalation.Domain+import Data.Text (Text)+import Keiki.Builder qualified as B+import Keiki.Core (HsPred, SymTransducer)+import Keiki.Core qualified as K+import Keiki.Symbolic qualified as S++escalationTransducer+  :: SymTransducer+       (HsPred EscalationRegs EscalationCommand)+       EscalationRegs+       EscalationVertex+       EscalationCommand+       EscalationEvent+escalationTransducer =+  B.buildTransducer EscalationOpen initialEscalationRegs isTerminal do+    B.from EscalationOpen do+      B.onCmd inCtorNoteRaised $ \d -> B.do+        B.emit wireRaisedNoted (RaisedNotedTermFields+          { incidentId = d.incidentId+          })+        B.goto EscalationOpen+      B.onCmd inCtorNoteAcknowledged $ \d -> B.do+        B.emit wireAcknowledged (AcknowledgedTermFields+          { incidentId = d.incidentId+          })+        B.goto EscalationOpen+      B.onCmd inCtorNoteIgnored $ \_d -> B.do+        B.noEmit+        B.goto EscalationOpen+      B.onCmd inCtorActivateDormant $ \d -> B.do+        B.emit wireDormantActivated (DormantActivatedTermFields+          { incidentId = d.incidentId+          })+        B.goto EscalationDormant+ where+  isTerminal = \case++    _ -> False++escalationFoldFingerprint :: Text+escalationFoldFingerprint = "c698d1c8c31d347428f9798264dcb612"++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.+escalationPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]+escalationPredicateVerifications = sequence+  [ verifyTransition "transition1OpenNoteRaised" GeneratedOwned EscalationOpen 0+  , verifyTransition "transition2OpenNoteAcknowledged" GeneratedOwned EscalationOpen 1+  , verifyTransition "transition3OpenNoteIgnored" GeneratedOwned EscalationOpen 2+  , verifyTransition "transition4OpenActivateDormant" GeneratedOwned EscalationOpen 3+  ]+ where+  verifyTransition label owner source edgeIndex =+    case drop edgeIndex (K.edgesOut escalationTransducer source) of+      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate+      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")
+ test/conformance-process-state-authority/Generated/IncidentResponse/Incident/BehaviorContract.hs view
@@ -0,0 +1,350 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.IncidentResponse.Incident.BehaviorContract+  ( BehaviorKey (..)+  , unBehaviorKey+  , ObligationKind (..)+  , EvidenceLevel (..)+  , GuardCoverage (..)+  , BehaviorRequirement (..)+  , RejectionClass (..)+  , LiveExpectation (..)+  , BehaviorWitness (..)+  , BehaviorFailure (..)+  , BehaviorConformanceReport (..)+  , behaviorRequirements+  , behaviorCoverageReport+  , behaviorConformancePassed+  , behaviorConformancePassedWith+  , renderBehaviorConformanceText+  ) where++import Generated.IncidentResponse.Incident.Codec (encodeIncidentEvent, parseIncidentEvent, incidentCodec)+import Generated.IncidentResponse.Incident.Domain+import Generated.IncidentResponse.Incident.Transducer (incidentTransducer)+import Generated.IncidentResponse.BehaviorSourceMap qualified as BehaviorSourceMap+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 (EdgeMode (..), EdgeRef (..), RegFile, ReplayAttribution (..), ReplayEventSpan (..), ReplaySuccess (..), StepFailure (..), StepSuccess (..), applyEventsDetailedEither, stepDetailedEither)+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+  { key :: !BehaviorKey+  , kind :: !ObligationKind+  , evidence :: !EvidenceLevel+  , guardCoverage :: !GuardCoverage+  , source :: !IncidentVertex+  , commandName :: !Text+  , expectedEdge :: !(Maybe (K.EdgeRef IncidentVertex))+  , target :: !(Maybe IncidentVertex)+  , eventKinds :: ![Text]+  }+  deriving stock (Eq, Show)++data RejectionClass = RejectNoOutgoingEdges | RejectNoMatchingEdge+  deriving stock (Eq, Show)++data LiveExpectation+  = Emits (NonEmpty IncidentEvent)+  | Rejects RejectionClass+  | NoOp+  deriving stock (Eq, Show)++data BehaviorWitness+  = Pending BehaviorKey+  | LiveWitness+      { key :: BehaviorKey+      , history :: [IncidentEvent]+      , command :: IncidentCommand+      , expected :: LiveExpectation+      }+  | ReplayWitness+      { key :: BehaviorKey+      , historyPrefix :: [IncidentEvent]+      , observedChunk :: [IncidentEvent]+      }+  deriving stock (Eq, Show)++data BehaviorFailure = BehaviorFailure+  { key :: !BehaviorKey+  , subject :: !Text+  , code :: !Text+  , detail :: !Text+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorFailure where+  toJSON behaviorFailure = object+    [ "key" .= unBehaviorKey behaviorFailure.key+    , "subject" .= behaviorFailure.subject+    , "code" .= behaviorFailure.code+    , "detail" .= behaviorFailure.detail+    ]++data BehaviorConformanceReport = BehaviorConformanceReport+  { required :: ![BehaviorKey]+  , filled :: ![BehaviorKey]+  , pending :: ![BehaviorKey]+  , missing :: ![BehaviorKey]+  , duplicate :: ![BehaviorKey]+  , stale :: ![BehaviorKey]+  , failed :: ![BehaviorFailure]+  , verified :: ![BehaviorKey]+  , unverified :: ![BehaviorKey]+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorConformanceReport where+  toJSON report = object+    [ "schema" .= ("keiro/behavior-conformance/1" :: Text)+    , "required" .= keyTexts report.required+    , "filled" .= keyTexts report.filled+    , "pending" .= keyTexts report.pending+    , "missing" .= keyTexts report.missing+    , "duplicate" .= keyTexts report.duplicate+    , "stale" .= keyTexts report.stale+    , "failed" .= report.failed+    , "verified" .= keyTexts report.verified+    , "unverified" .= keyTexts report.unverified+    ]++behaviorRequirements :: [BehaviorRequirement]+behaviorRequirements =+  [ -- IncidentOpen x EscalateIncident: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-0aad69728dee8fec"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = IncidentOpen+      , commandName = "EscalateIncident"+      , expectedEdge = (Just (K.EdgeRef IncidentOpen 1))+      , target = Just IncidentOpen+      , eventKinds = ["IncidentEscalated"]+      }+  , -- IncidentOpen x AcknowledgeIncident: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-36c541281e30554e"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = IncidentOpen+      , commandName = "AcknowledgeIncident"+      , expectedEdge = (Just (K.EdgeRef IncidentOpen 0))+      , target = Just IncidentOpen+      , eventKinds = ["IncidentAcknowledged"]+      }+  ]++behaviorCoverageReport :: [BehaviorWitness] -> BehaviorConformanceReport+behaviorCoverageReport witnesses =+  BehaviorConformanceReport+    { required = sortedKeys (Map.keys requiredByKey)+    , filled = sortedKeys [key | (key, [witness]) <- Map.toList witnessGroups, Map.member key requiredByKey, not (isPending witness)]+    , pending = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, Map.member key requiredByKey, any isPending rows]+    , missing = sortedKeys [key | key <- Map.keys requiredByKey, Map.notMember key witnessGroups]+    , duplicate = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, length rows > 1]+    , stale = sortedKeys [key | key <- Map.keys witnessGroups, Map.notMember key requiredByKey]+    , failed = sortOn (unBehaviorKey . (.key)) failures+    , verified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, proofStrength requirement]+    , unverified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, not (proofStrength requirement)]+    }+ where+  requiredByKey = Map.fromList [(requirement.key, 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.pending+    && null report.missing+    && null report.duplicate+    && null report.stale+    && null report.failed+    && (not failOnUnverified || null report.unverified)++renderBehaviorConformanceText :: BehaviorConformanceReport -> Text+renderBehaviorConformanceText report = T.unlines+  [ "behavior conformance: Incident"+  , "schema: keiro/behavior-conformance/1"+  , countLine "required" report.required+  , countLine "filled" report.filled+  , countLine "pending" report.pending+  , countLine "missing" report.missing+  , countLine "duplicate" report.duplicate+  , countLine "stale" report.stale+  , "failed: " <> tshow (length report.failed)+  , countLine "verified" report.verified+  , countLine "unverified" report.unverified+  ] <> T.unlines ["FAIL " <> unBehaviorKey behaviorFailure.key <> " " <> behaviorFailure.subject <> " [" <> behaviorFailure.code <> "] " <> behaviorFailure.detail | behaviorFailure <- report.failed]++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 -> [IncidentEvent] -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runLive requirement history command expectation = do+  settled <- settleHistory requirement "history" history+  ensure requirement (K.replaySuccessState settled == requirement.source) "history-wrong-source" "history does not settle at the required source vertex"+  ensure requirement (commandKind command == requirement.commandName) "command-mismatch" "witness command constructor does not match the required state/command cell"+  case requirement.kind 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 -> (IncidentVertex, K.RegFile IncidentRegs) -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runRejection requirement seed command expectation = case expectation of+  Emits _ -> failure requirement "expectation-kind" "a rejection requirement cannot expect emitted events"+  NoOp -> failure requirement "expectation-kind" "a rejection requirement cannot expect an accepted no-op"+  Rejects expectedClass -> case K.stepDetailedEither incidentTransducer 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 -> (IncidentVertex, K.RegFile IncidentRegs) -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runAcceptance requirement seed command expectation = case expectation of+  Rejects _ -> failure requirement "expectation-kind" "a live-transition requirement needs Emits or NoOp"+  NoOp -> case K.stepDetailedEither incidentTransducer 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"+  Emits expectedEvents -> case K.stepDetailedEither incidentTransducer 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.eventKinds) "event-envelope-mismatch" ("runtime event kinds differ from the declared ordered envelope; actual=" <> tshow (map eventKind actual) <> " expected=" <> tshow requirement.eventKinds)+      decoded <- either (failure requirement "emitted-codec-decode") Right (decodeEvents actual)+      replayed <- case K.applyEventsDetailedEither incidentTransducer 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)++checkAcceptedEnvelope :: BehaviorRequirement -> K.StepSuccess IncidentRegs IncidentVertex IncidentEvent -> 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.expectedEdge) "edge-attribution" ("runtime selected a different guarded sibling; actual=" <> tshow (Just (K.stepSuccessEdge success)) <> " expected=" <> tshow requirement.expectedEdge)+  ensure requirement (Just (K.stepSuccessState success) == requirement.target) "target-mismatch" ("runtime reached a different target vertex; actual=" <> tshow (Just (K.stepSuccessState success)) <> " expected=" <> tshow requirement.target)++runReplay :: BehaviorRequirement -> [IncidentEvent] -> [IncidentEvent] -> Either BehaviorFailure ()+runReplay requirement prefix chunk = case requirement.kind of+  ReplayTransition -> do+    settled <- settleHistory requirement "history-prefix" prefix+    ensure requirement (K.replaySuccessState settled == requirement.source) "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 incidentTransducer (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.target) "target-mismatch" ("replay chunk reached a different target vertex; actual=" <> tshow (Just (K.replaySuccessState replayed)) <> " expected=" <> tshow requirement.target)+    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 IncidentVertex] -> Either BehaviorFailure ()+checkSingleAttribution requirement expectedMode eventCount trace = case trace of+  [attribution] -> do+    ensure requirement (Just (K.replayAttributionEdge attribution) == requirement.expectedEdge) "replay-edge-attribution" ("replay selected a different edge; actual=" <> tshow (Just (K.replayAttributionEdge attribution)) <> " expected=" <> tshow requirement.expectedEdge)+    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.source) "replay-source-attribution" ("replay attribution starts at the wrong source; actual=" <> tshow (K.replayAttributionSource attribution) <> " expected=" <> tshow requirement.source)+    ensure requirement (Just (K.replayAttributionTarget attribution) == requirement.target) "replay-target-attribution" ("replay attribution ends at the wrong target; actual=" <> tshow (Just (K.replayAttributionTarget attribution)) <> " expected=" <> tshow requirement.target)+    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 -> [IncidentEvent] -> Either BehaviorFailure (K.ReplaySuccess IncidentRegs IncidentVertex)+settleHistory requirement label history = do+  decoded <- either (failure requirement (label <> "-codec-decode")) Right (decodeEvents history)+  case K.applyEventsDetailedEither incidentTransducer (IncidentOpen, initialIncidentRegs) decoded of+    Left replayFailure -> failure requirement (label <> "-replay-failed") (tshow replayFailure)+    Right replaySuccess -> Right replaySuccess++decodeEvents :: [IncidentEvent] -> Either Text [IncidentEvent]+decodeEvents = traverse (\event -> parseIncidentEvent (Codec.eventType incidentCodec event) (encodeIncidentEvent event))++commandKind :: IncidentCommand -> Text+commandKind command = case command of+  AcknowledgeIncident _ -> "AcknowledgeIncident"+  EscalateIncident _ -> "EscalateIncident"++eventKind :: IncidentEvent -> Text+eventKind event = case Codec.eventType incidentCodec event of Codec.EventType tag -> tag++regsEqual :: K.RegFile IncidentRegs -> K.RegFile IncidentRegs -> Bool+regsEqual _ _ = True++proofStrength :: BehaviorRequirement -> Bool+proofStrength requirement =+  requirement.evidence == GeneratedAuthoritative+    && requirement.guardCoverage `elem` [GuardTotal, GuardNotApplicable]++behaviorWitnessKey :: BehaviorWitness -> BehaviorKey+behaviorWitnessKey witness = case witness of+  Pending key -> key+  LiveWitness { key = key } -> key+  ReplayWitness { key = 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.key+        (tshow requirement.source <> " x " <> requirement.commandName <> ": " <> kindPhrase <> " (" <> BehaviorSourceMap.renderBehaviorSourceLocation (unBehaviorKey requirement.key) <> ")")+        code+        detail+    )+ where+  kindPhrase = case requirement.kind 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
+ test/conformance-process-state-authority/Generated/IncidentResponse/Incident/Codec.hs view
@@ -0,0 +1,77 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.IncidentResponse.Incident.Codec (+    incidentCodec,+    parseIncidentEvent,+    encodeIncidentEvent,+) where++import Generated.IncidentResponse.Incident.Domain+import Generated.IncidentResponse.Nominals (incidentIdText)+import Generated.IncidentResponse.Nominals.Internal (unsafeIncidentIdFromLegacyText)+import Data.Aeson (Value, object, withObject, (.:), (.=))+import Data.Aeson.Types (parseEither)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text (Text)+import qualified Data.Text as T+import Keiro.Codec (Codec (..), EventType (..))++++++incidentEventTypes :: NonEmpty EventType+incidentEventTypes = EventType "IncidentAcknowledged" :| [EventType "IncidentEscalated"]++incidentCodec :: Codec IncidentEvent+incidentCodec =+  Codec+    { eventTypes = incidentEventTypes+    , eventType = \case+        IncidentAcknowledged{} -> EventType "IncidentAcknowledged"+        IncidentEscalated{} -> EventType "IncidentEscalated"+    , schemaVersion = 1+    , encode = encodeIncidentEvent+    , decode = parseIncidentEvent+    , upcasters = []+    }++encodeIncidentEvent :: IncidentEvent -> Value+encodeIncidentEvent = \case+  IncidentAcknowledged payload ->+    object+      [ "kind" .= ("IncidentAcknowledged" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]+  IncidentEscalated payload ->+    object+      [ "kind" .= ("IncidentEscalated" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]++parseIncidentEvent :: EventType -> Value -> Either Text IncidentEvent+parseIncidentEvent (EventType tag) = mapLeftText . parseEither (withObject "IncidentEvent" go)+  where+    go o = do+      case tag of+        "IncidentAcknowledged" ->+          IncidentAcknowledged+            <$> ( IncidentAcknowledgedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        "IncidentEscalated" ->+          IncidentEscalated+            <$> ( IncidentEscalatedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes incidentEventTypes)++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
+ test/conformance-process-state-authority/Generated/IncidentResponse/Incident/Domain.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE TemplateHaskell #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.IncidentResponse.Incident.Domain where++import GHC.Generics (Generic)+import Keiki.Core (RegFile (..))+import Generated.IncidentResponse.Nominals (IncidentId)+import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)++data IncidentVertex = IncidentOpen+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)++data AcknowledgeIncidentData = AcknowledgeIncidentData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data EscalateIncidentData = EscalateIncidentData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentCommand = AcknowledgeIncident !AcknowledgeIncidentData+  | EscalateIncident !EscalateIncidentData+  deriving stock (Generic, Eq, Show)++data IncidentAcknowledgedData = IncidentAcknowledgedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentEscalatedData = IncidentEscalatedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentEvent = IncidentAcknowledged !IncidentAcknowledgedData+  | IncidentEscalated !IncidentEscalatedData+  deriving stock (Generic, Eq, Show)++type IncidentRegs =+  '[]++initialIncidentRegs :: RegFile IncidentRegs+initialIncidentRegs =+  RNil++$(deriveAggregateCtorsAll ''IncidentCommand ''IncidentRegs)++++$(deriveWireCtorsAll ''IncidentEvent)
+ test/conformance-process-state-authority/Generated/IncidentResponse/Incident/EventStream.hs view
@@ -0,0 +1,49 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.IncidentResponse.Incident.EventStream+  ( incidentCategory+  , incidentCommandCategory+  , incidentEventStream+  , incidentEventStreamDef+  , IncidentEventStream+  , IncidentEventStreamDef+  ) where++import Generated.IncidentResponse.Incident.Domain+import Generated.IncidentResponse.Incident.Codec (incidentCodec)+import Generated.IncidentResponse.Incident.Transducer (incidentTransducer)+import Keiki.Core (HsPred)+import Keiro.EventStream (EventStream (..), SnapshotPolicy (..))+import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow)+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.+incidentCategory :: Stream.StreamCategory IncidentEventStreamDef+incidentCategory = Stream.categoryUnsafe "incident"++-- The same category text, typed for command envelopes such as PMCommand.+incidentCommandCategory :: Stream.StreamCategory IncidentCommand+incidentCommandCategory = Stream.categoryUnsafe "incident"++type IncidentEventStreamDef =+  EventStream (HsPred IncidentRegs IncidentCommand) IncidentRegs IncidentVertex IncidentCommand IncidentEvent++type IncidentEventStream =+  ValidatedEventStream (HsPred IncidentRegs IncidentCommand) IncidentRegs IncidentVertex IncidentCommand IncidentEvent++incidentEventStreamDef :: IncidentEventStreamDef+incidentEventStreamDef =+  EventStream+    { transducer = incidentTransducer,+      initialState = IncidentOpen,+      initialRegisters = initialIncidentRegs,+      eventCodec = incidentCodec,+      resolveStreamName = Stream.streamName,+      snapshotPolicy = Never,+      stateCodec = Nothing+    }++incidentEventStream :: IncidentEventStream+incidentEventStream =+  mkEventStreamOrThrow "Incident" incidentEventStreamDef
+ test/conformance-process-state-authority/Generated/IncidentResponse/Incident/Harness.hs view
@@ -0,0 +1,87 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.IncidentResponse.Incident.Harness (harnessAssertions) where++import Generated.IncidentResponse.Incident.Domain+import Generated.IncidentResponse.Incident.Codec (encodeIncidentEvent, parseIncidentEvent, incidentCodec)+import Generated.IncidentResponse.Incident.Transducer (incidentTransducer)+import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)+import Keiro.Codec (eventType)+import Generated.IncidentResponse.Nominals (IncidentId, parseIncidentId)++-- | (label, passed). A driver runs these and exits non-zero on any False,+-- naming the failing assertion. Filling a hole wrongly turns a specific+-- entry False; the scaffold cannot.+harnessAssertions :: [(String, Bool)]+harnessAssertions =+  [ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions incidentTransducer))+  -- clock-free: spec samples no wall clock (verified at scaffold time)+  , ("golden round-trip: IncidentAcknowledged", roundTrips sampleEventIncidentAcknowledged)+  , ("golden round-trip: IncidentEscalated", roundTrips sampleEventIncidentEscalated)+  , ("accepts AcknowledgeIncident from IncidentOpen", acceptAcknowledgeIncident)+  , ("accepts EscalateIncident from IncidentOpen", acceptEscalateIncident)+  ]+  ++ forwardReplayAcknowledgeIncident+  ++ forwardReplayEscalateIncident++roundTrips :: IncidentEvent -> Bool+roundTrips e = parseIncidentEvent (eventType incidentCodec e) (encodeIncidentEvent e) == Right e++sampleIncidentId :: IncidentId+sampleIncidentId =+  case parseIncidentId "inc_01h455vb4pex5vsknk084sn02q" of+    Right parsed -> parsed+    Left problem -> error (show problem)++sampleEventIncidentAcknowledged :: IncidentEvent+sampleEventIncidentAcknowledged = IncidentAcknowledged (IncidentAcknowledgedData sampleIncidentId)++sampleEventIncidentEscalated :: IncidentEvent+sampleEventIncidentEscalated = IncidentEscalated (IncidentEscalatedData sampleIncidentId)++acceptAcknowledgeIncident :: Bool+acceptAcknowledgeIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (AcknowledgeIncident (AcknowledgeIncidentData sampleIncidentId)) of+    Just (v, _, _) -> v == IncidentOpen+    Nothing -> False++acceptEscalateIncident :: Bool+acceptEscalateIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (EscalateIncident (EscalateIncidentData sampleIncidentId)) of+    Just (v, _, _) -> v == IncidentOpen+    Nothing -> False++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayAcknowledgeIncident :: [(String, Bool)]+forwardReplayAcknowledgeIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (AcknowledgeIncident (AcknowledgeIncidentData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseIncidentEvent (eventType incidentCodec event) (encodeIncidentEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither incidentTransducer (IncidentOpen, initialIncidentRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: AcknowledgeIncident from IncidentOpen -- "++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayEscalateIncident :: [(String, Bool)]+forwardReplayEscalateIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (EscalateIncident (EscalateIncidentData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseIncidentEvent (eventType incidentCodec event) (encodeIncidentEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither incidentTransducer (IncidentOpen, initialIncidentRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: EscalateIncident from IncidentOpen -- "
+ test/conformance-process-state-authority/Generated/IncidentResponse/Incident/Projection.hs view
@@ -0,0 +1,4 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.IncidentResponse.Incident.Projection () where++-- No projection declarations are present; this module keeps the generated manifest inventory total.
+ test/conformance-process-state-authority/Generated/IncidentResponse/Incident/Transducer.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE QualifiedDo #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.IncidentResponse.Incident.Transducer+  ( incidentTransducer+  , incidentFoldFingerprint+  , BehaviorOwnership (..)+  , incidentPredicateVerifications+  ) where++import Generated.IncidentResponse.Incident.Domain+import Data.Text (Text)+import Keiki.Builder qualified as B+import Keiki.Core (HsPred, SymTransducer)+import Keiki.Core qualified as K+import Keiki.Symbolic qualified as S++incidentTransducer+  :: SymTransducer+       (HsPred IncidentRegs IncidentCommand)+       IncidentRegs+       IncidentVertex+       IncidentCommand+       IncidentEvent+incidentTransducer =+  B.buildTransducer IncidentOpen initialIncidentRegs isTerminal do+    B.from IncidentOpen do+      B.onCmd inCtorAcknowledgeIncident $ \d -> B.do+        B.emit wireIncidentAcknowledged (IncidentAcknowledgedTermFields+          { incidentId = d.incidentId+          })+        B.goto IncidentOpen+      B.onCmd inCtorEscalateIncident $ \d -> B.do+        B.emit wireIncidentEscalated (IncidentEscalatedTermFields+          { incidentId = d.incidentId+          })+        B.goto IncidentOpen+ where+  isTerminal = \case++    _ -> False++incidentFoldFingerprint :: Text+incidentFoldFingerprint = "74127065ce035a7e6b53d4e0f8db61f4"++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.+incidentPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]+incidentPredicateVerifications = sequence+  [ verifyTransition "transition1OpenAcknowledgeIncident" GeneratedOwned IncidentOpen 0+  , verifyTransition "transition2OpenEscalateIncident" GeneratedOwned IncidentOpen 1+  ]+ where+  verifyTransition label owner source edgeIndex =+    case drop edgeIndex (K.edgesOut incidentTransducer source) of+      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate+      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")
+ test/conformance-process-state-authority/Generated/IncidentResponse/IncidentEscalation/Input.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveAnyClass #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process input IncidentEscalation; do not edit.+module Generated.IncidentResponse.IncidentEscalation.Input (IncidentEscalationInput (..)) where++import Data.Aeson (FromJSON, ToJSON)+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Generated.IncidentResponse.Nominals qualified as N++data IncidentEscalationInput+  = IncidentReported+      { incidentId :: !N.IncidentId+      , severity :: !N.Severity+      , raisedAt :: !UTCTime+      }+  | ResponderAcked+      { incidentId :: !N.IncidentId+      , ackedAt :: !UTCTime+      }+  | ResponderIgnored+      { incidentId :: !N.IncidentId+      }+  | IncidentNoted+      { incidentId :: !N.IncidentId+      }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromJSON, ToJSON)
+ test/conformance-process-state-authority/Generated/IncidentResponse/IncidentEscalation/Process.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process reaction IncidentEscalation; do not edit.+module Generated.IncidentResponse.IncidentEscalation.Process+  ( IncidentEscalationInput (..)+  , incidentEscalationProcessName+  , incidentEscalationCategory+  , incidentEscalationProcessWorkerOptions+  , incidentEscalationReactionVersion+  , incidentEscalationReactionFingerprint+  , incidentEscalationReact+  , incidentEscalationProcessManager+  , incidentEscalationRunProcessWorker+  , EscalationPayload (..)+  , incidentEscalationEscalationTimerRequest+  , incidentEscalationTimerWorkerOptions+  , incidentEscalationFireTimer+  ) where++import Data.Text (Text)+import Data.Aeson (FromJSON, ToJSON)+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as BS+import Data.Text qualified as T+import Data.Text.Encoding (encodeUtf8)+import Data.Time (UTCTime, addUTCTime)+import Data.UUID (UUID)+import Data.UUID.V5 qualified as UUID.V5+import GHC.Generics (Generic)+import Numeric.Natural (Natural)+import Generated.IncidentResponse.IncidentEscalation.Input (IncidentEscalationInput (..))+import IncidentResponse.IncidentEscalation.ProcessHoles (decodeIncidentEscalationInput)+import Generated.IncidentResponse.Escalation.Domain qualified as Saga+import Generated.IncidentResponse.Escalation.EventStream (escalationEventStream, EscalationEventStreamDef)+import Generated.IncidentResponse.Incident.Domain qualified as Target+import Generated.IncidentResponse.Incident.EventStream (incidentCategory, incidentCommandCategory, incidentEventStream)+import Generated.IncidentResponse.Nominals qualified as N+import Keiro.Command (DomainCommandHandler (..), SilentDomainDecision (..))+import Keiro.Command (CommandError (..), RunCommandOptions (..), runCommand)+import Keiro.ProcessManager (PMCommand (..), confirmBenignDuplicate)+import Keiro.ProcessManager.Reaction qualified as Reaction+import Keiro.Stream qualified as Stream+import Keiro.DeterministicId (identitySeedBytes)+import Keiro.Timer (TimerId (..), TimerRequest (..), TimerWorkerOptions (..))+import Kiroku.Store.Types (EventId (..))+import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))+import Shibuya.Core.Ack (RetryDelay (..))++data EscalationPayload = EscalationPayload+  { kind :: !Text+  , incidentId :: !N.IncidentId+  , severity :: !N.Severity+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromJSON, ToJSON)++incidentEscalationEscalationTimerRequest :: Text -> UTCTime -> N.IncidentId -> N.Severity -> TimerRequest+incidentEscalationEscalationTimerRequest correlationId fireAtTime payloadIncidentId payloadSeverity =+  TimerRequest+    { timerId = TimerId (reactionIdentity "incident-escalation-timer:" correlationId)+    , processManagerName = incidentEscalationProcessName+    , correlationId = correlationId+    , fireAt = fireAtTime+    , payload = Aeson.toJSON (EscalationPayload { kind = "escalation", incidentId = payloadIncidentId, severity = payloadSeverity })+    }++incidentEscalationProcessName :: Text+incidentEscalationProcessName = "incident-escalation"++incidentEscalationCategory :: Stream.StreamCategory EscalationEventStreamDef+incidentEscalationCategory = Stream.categoryUnsafe "escalation"++incidentEscalationProcessWorkerOptions :: WorkerOptions es msg+incidentEscalationProcessWorkerOptions =+  WorkerOptions+    { poisonPolicy = PoisonHalt,+      rejectedCommandPolicy = RejectedHalt,+      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning+      metrics = Nothing -- runtime configuration; install at call site+    }++incidentEscalationTimerWorkerOptions :: TimerWorkerOptions+incidentEscalationTimerWorkerOptions =+  TimerWorkerOptions+    { maxAttempts = Just 5+    , requeueStuckAfter = Just 300+    }+-- Operator dead-letter guidance: "escalation timer exceeded ceiling"++incidentEscalationReactionVersion :: Natural+incidentEscalationReactionVersion = 1++incidentEscalationReactionFingerprint :: Text+incidentEscalationReactionFingerprint = "74ccfa3e3e78a8d747546629dce80be851ec3dd2babbd7ddea34b0746f19c7c7"++incidentEscalationCorrelate :: IncidentEscalationInput -> Text+incidentEscalationCorrelate input = case input of+  IncidentReported { incidentId } -> (N.incidentIdText incidentId)+  ResponderAcked { incidentId } -> (N.incidentIdText incidentId)+  ResponderIgnored { incidentId } -> (N.incidentIdText incidentId)+  IncidentNoted { incidentId } -> (N.incidentIdText incidentId)++incidentEscalationReact :: IncidentEscalationInput -> Reaction.ReactionPlan Saga.EscalationCommand Target.IncidentCommand+incidentEscalationReact input = case input of+  IncidentReported { incidentId, severity, raisedAt }+    | (severity == N.Sev1) -> Reaction.AdvanceReaction { command = Saga.NoteRaised (Saga.NoteRaisedData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowSchedule Reaction.Rearm (incidentEscalationEscalationTimerRequest (N.incidentIdText incidentId) (addUTCTime 300 raisedAt) incidentId severity)], onAccepted = [] }+    | otherwise -> Reaction.AdvanceReaction { command = Saga.NoteRaised (Saga.NoteRaisedData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowSchedule Reaction.Rearm (incidentEscalationEscalationTimerRequest (N.incidentIdText incidentId) (addUTCTime 3600 raisedAt) incidentId severity)], onAccepted = [] }+  ResponderAcked { incidentId, ackedAt = _ackedAt }+    -> Reaction.AdvanceReaction { command = Saga.NoteAcknowledged (Saga.NoteAcknowledgedData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowCancel (TimerId (reactionIdentity "incident-escalation-timer:" (N.incidentIdText incidentId)))], onAccepted = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.AcknowledgeIncident (Target.AcknowledgeIncidentData { Target.incidentId = incidentId })))] }+  ResponderIgnored { incidentId }+    -> Reaction.AdvanceReaction { command = Saga.NoteIgnored (Saga.NoteIgnoredData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowCancel (TimerId (reactionIdentity "incident-escalation-timer:" (N.incidentIdText incidentId)))], onAccepted = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.AcknowledgeIncident (Target.AcknowledgeIncidentData { Target.incidentId = incidentId })))] }+  IncidentNoted {}+    -> Reaction.NoAdvance []++incidentEscalationProcessManager =+  Reaction.ReactiveProcessManager+    { name = incidentEscalationProcessName+    , correlate = incidentEscalationCorrelate+    , sagaHandler = DomainCommandHandler { eventStream = escalationEventStream, classifySilent = \_ -> SilentNoOp () }+    , streamFor = Stream.entityStream incidentEscalationCategory+    , targetEventStream = incidentEventStream+    , targetProjections = const []+    , react = incidentEscalationReact+    }++incidentEscalationRunProcessWorker options adapter =+  Reaction.runReactiveProcessManagerWorkerWith+    incidentEscalationProcessWorkerOptions+    options+    incidentEscalationProcessManager+    adapter+    (\event -> case decodeIncidentEscalationInput event of Nothing -> Nothing; Just input -> Just (event, input))++incidentEscalationFireTimer options timer+  | timer.timerId == TimerId (reactionIdentity "incident-escalation-timer:" timer.correlationId) = incidentEscalationEscalationFire options timer+  | otherwise = pure Nothing++incidentEscalationEscalationFire options timer+  | timer.processManagerName /= incidentEscalationProcessName = pure Nothing+  | otherwise =+      case (Aeson.fromJSON timer.payload :: Aeson.Result EscalationPayload) of+        Aeson.Error _ -> pure Nothing+        Aeson.Success decoded -> do+          let firedId = EventId (reactionIdentity "incident-escalation-fired:" timer.correlationId)+              target = Stream.entityStream incidentCategory timer.correlationId+          result <-+            runCommand+              (options { eventIds = [firedId] })+              incidentEventStream+              target+              (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = decoded.incidentId }))+          case result of+            Right {} -> pure (Just firedId)+            Left err -> do+              benign <- confirmBenignDuplicate (Stream.streamName target) firedId err+              pure $ if benign then Just firedId else case err of+                CommandRejected -> Just firedId+                CommandAmbiguous _ -> Nothing+                _ -> Nothing++reactionIdentity :: Text -> Text -> UUID+reactionIdentity prefix correlation =+  UUID.V5.generateNamed UUID.V5.namespaceURL (identitySeedBytes (T.concat (map field [prefix, correlation])))+  where+    field value = T.pack (show (BS.length (encodeUtf8 value))) <> ":" <> value
+ test/conformance-process-state-authority/Generated/IncidentResponse/IncidentEscalation/ProcessHarness.hs view
@@ -0,0 +1,21 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process IncidentEscalation; do not edit.+module Generated.IncidentResponse.IncidentEscalation.ProcessHarness (processHarnessValues) where++-- | (label, value): the spec's deterministic process/timer decisions,+-- lowered to plain values so a driver can assert them against a committed+-- expectation. The driver's expectation is hand-written (not generated), so a+-- spec change that alters a decision diverges from it and turns a specific+-- assertion red — the spec->behaviour pin. (Live-runtime behavioural+-- conformance of the filled ProcessManager is the M5 step.)+processHarnessValues :: [(String, String)]+processHarnessValues =+  [ ("reactionOwnership", "generated-declarative")+  , ("reactionVersion", "1")+  , ("reactionFingerprint", "74ccfa3e3e78a8d747546629dce80be851ec3dd2babbd7ddea34b0746f19c7c7")+  , ("reaction.IncidentReported.0", "guard=input.severity == Severity.Sev1;advance=NoteRaised;followUps=schedule:escalation:rearm;accepted=")+  , ("reaction.IncidentReported.1", "guard=otherwise;advance=NoteRaised;followUps=schedule:escalation:rearm;accepted=")+  , ("reaction.ResponderAcked.0", "guard=always;advance=NoteAcknowledged;followUps=cancel:escalation;accepted=dispatch:Incident.AcknowledgeIncident")+  , ("reaction.ResponderIgnored.0", "guard=always;advance=NoteIgnored;followUps=cancel:escalation;accepted=dispatch:Incident.AcknowledgeIncident")+  , ("reaction.IncidentNoted.0", "guard=always;advance=none;followUps=;accepted=")+  , ("timer.escalation", "idPrefix=incident-escalation-timer:;payload=kind,incidentId,severity;fire=Incident.EscalateIncident;firedEventPrefix=incident-escalation-fired:")+  ]
+ test/conformance-process-state-authority/Generated/IncidentResponse/Nominals.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveAnyClass #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context incident-response generated nominal declarations; do not edit.+module Generated.IncidentResponse.Nominals+  ( EscalationNoOp (..)+  , escalationNoOpText+  , EscalationRejection (..)+  , escalationRejectionText+  , IncidentId+  , parseIncidentId+  , mkIncidentId+  , incidentIdText+  , Severity (..)+  , severityText+  ) where++import Data.Aeson (FromJSON, ToJSON)+import Data.Text (Text)+import GHC.Generics (Generic)+import Keiki.Shape (CanonicalTypeName)+import Generated.IncidentResponse.Nominals.Internal (IncidentId, mkIncidentId, parseIncidentId, incidentIdText)++data EscalationNoOp = Ignored+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)+  deriving anyclass (ToJSON, FromJSON)++instance CanonicalTypeName EscalationNoOp++escalationNoOpText :: EscalationNoOp -> Text+escalationNoOpText = \case+  Ignored -> "ignored"++data EscalationRejection = Invalid+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)+  deriving anyclass (ToJSON, FromJSON)++instance CanonicalTypeName EscalationRejection++escalationRejectionText :: EscalationRejection -> Text+escalationRejectionText = \case+  Invalid -> "invalid"++++data Severity = Sev1 | Sev2 | Sev3+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)+  deriving anyclass (ToJSON, FromJSON)++instance CanonicalTypeName Severity++severityText :: Severity -> Text+severityText = \case+  Sev1 -> "sev1"+  Sev2 -> "sev2"+  Sev3 -> "sev3"
+ test/conformance-process-state-authority/Generated/IncidentResponse/Nominals/Internal.hs view
@@ -0,0 +1,40 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context incident-response generated nominal ID internals; do not edit.+module Generated.IncidentResponse.Nominals.Internal+  ( IncidentId+  , parseIncidentId+  , mkIncidentId+  , incidentIdText+  , unsafeIncidentIdFromLegacyText+  ) 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)++newtype IncidentId = IncidentId Text+  deriving stock (Generic, Eq, Ord, Show)++instance CanonicalTypeName IncidentId++instance ToJSON IncidentId where+  toJSON = toJSON . incidentIdText++instance FromJSON IncidentId where+  parseJSON = withText "IncidentId" (either (fail . T.unpack) pure . parseIncidentId)++parseIncidentId :: Text -> Either Text IncidentId+parseIncidentId input = case validateIdDomainText (typeIdV7Domain "inc") input of+  Left reason -> Left (T.pack (show reason))+  Right () -> Right (IncidentId input)++mkIncidentId :: Text -> Either Text IncidentId+mkIncidentId = parseIncidentId++incidentIdText :: IncidentId -> Text+incidentIdText (IncidentId value) = value++unsafeIncidentIdFromLegacyText :: Text -> IncidentId+unsafeIncidentIdFromLegacyText = IncidentId
+ test/conformance-process-state-authority/Generated/IncidentResponse/ReplayAudit.hs view
@@ -0,0 +1,30 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context incident-response replay-audit assembly; do not edit.+--+-- 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 Generated.IncidentResponse.ReplayAudit (auditTargets) where++import Generated.IncidentResponse.Escalation.EventStream qualified as Escalation+import Generated.IncidentResponse.Incident.EventStream qualified as Incident+import Keiro.ReplayAudit (AuditTarget (..), SomeAuditTarget (..), streamInCategory)+import Keiro.Stream qualified as Stream++auditTargets :: [SomeAuditTarget]+auditTargets =+  [ SomeAuditTarget+      AuditTarget+        { eventStream = Escalation.escalationEventStream+        , category = Stream.categoryText Escalation.escalationCategory+        , mkStream = streamInCategory (Stream.categoryText Escalation.escalationCategory)+        }+  , SomeAuditTarget+      AuditTarget+        { eventStream = Incident.incidentEventStream+        , category = Stream.categoryText Incident.incidentCategory+        , mkStream = streamInCategory (Stream.categoryText Incident.incidentCategory)+        }+  ]
+ test/conformance-process-state-authority/IncidentResponse/Escalation/BehaviorHoles.hs view
@@ -0,0 +1,16 @@+-- Consumer-owned behavioral witnesses. Created once; never overwritten.+module IncidentResponse.Escalation.BehaviorHoles (behaviorWitnesses) where++import Generated.IncidentResponse.Escalation.BehaviorContract++behaviorWitnesses :: [BehaviorWitness]+behaviorWitnesses =+  [ Pending (BehaviorKey "behavior-v1-2144226ce8222855") -- EscalationOpen x NoteRaised: live transition+  , Pending (BehaviorKey "behavior-v1-65795e7a28345559") -- EscalationOpen x NoteAcknowledged: live transition+  , Pending (BehaviorKey "behavior-v1-00b0b13023eea6f8") -- EscalationOpen x NoteIgnored: typed no-op transition+  , Pending (BehaviorKey "behavior-v1-3d0e024503e32404") -- EscalationOpen x ActivateDormant: live transition+  , Pending (BehaviorKey "behavior-v1-75011409d18e29c3") -- EscalationDormant x NoteRaised: required rejection+  , Pending (BehaviorKey "behavior-v1-16209316858bb8c3") -- EscalationDormant x NoteAcknowledged: required rejection+  , Pending (BehaviorKey "behavior-v1-eecae8fa281fddcf") -- EscalationDormant x NoteIgnored: required rejection+  , Pending (BehaviorKey "behavior-v1-8f58f8301e7a66f3") -- EscalationDormant x ActivateDormant: required rejection+  ]
+ test/conformance-process-state-authority/IncidentResponse/Incident/BehaviorHoles.hs view
@@ -0,0 +1,10 @@+-- Consumer-owned behavioral witnesses. Created once; never overwritten.+module IncidentResponse.Incident.BehaviorHoles (behaviorWitnesses) where++import Generated.IncidentResponse.Incident.BehaviorContract++behaviorWitnesses :: [BehaviorWitness]+behaviorWitnesses =+  [ Pending (BehaviorKey "behavior-v1-0aad69728dee8fec") -- IncidentOpen x EscalateIncident: live transition+  , Pending (BehaviorKey "behavior-v1-36c541281e30554e") -- IncidentOpen x AcknowledgeIncident: live transition+  ]
+ test/conformance-process-state-authority/IncidentResponse/IncidentEscalation/ProcessHoles.hs view
@@ -0,0 +1,11 @@+-- keiro-dsl process-hole contract v1+-- HAND-OWNED typed decoder; created once and never overwritten.+module IncidentResponse.IncidentEscalation.ProcessHoles (decodeIncidentEscalationInput) where++import Data.Aeson (parseJSON)+import Data.Aeson.Types (parseMaybe)+import Generated.IncidentResponse.IncidentEscalation.Input (IncidentEscalationInput)+import Kiroku.Store.Types (RecordedEvent (..))++decodeIncidentEscalationInput :: RecordedEvent -> Maybe IncidentEscalationInput+decodeIncidentEscalationInput RecordedEvent {payload} = parseMaybe parseJSON payload
+ test/conformance-process-state-authority/Main.hs view
@@ -0,0 +1,195 @@+module Main (main) where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar, takeMVar)+import Control.Monad (forM_, replicateM, replicateM_, unless)+import Data.Aeson (ToJSON)+import Data.Aeson qualified as Aeson+import Data.Text (Text)+import Data.Time (UTCTime (..), secondsToDiffTime)+import Data.Time.Calendar (Day (ModifiedJulianDay))+import Data.UUID (UUID)+import Data.UUID qualified as UUID+import Data.UUID.V5 qualified as UUID.V5+import Data.Vector qualified as Vector+import Generated.IncidentResponse.Incident.Domain qualified as Target+import Generated.IncidentResponse.Incident.EventStream (incidentCategory, incidentEventStream)+import Generated.IncidentResponse.IncidentEscalation.Process+import Generated.IncidentResponse.Nominals (Severity (..), incidentIdText, mkIncidentId)+import Keiro.Command (RunCommandOptions (..), defaultRunCommandOptions, runCommand)+import Keiro.ProcessManager (PMCommand (..), PMCommandResult (..))+import Keiro.ProcessManager.Reaction qualified as Reaction+import Keiro.Stream qualified as Stream+import Keiro.Test.Postgres (StoreRunner (..), withFreshResourceStore, withMigratedSuite)+import Kiroku.Store qualified as Store+import Kiroku.Store.Types (EventId (..), EventType (..), GlobalPosition (..), RecordedEvent (..), StreamId (..), StreamName (..), StreamVersion (..))+import System.Environment (getArgs)+import System.IO (hPutStrLn, stderr)++main :: IO ()+main = getArgs >>= \case+  [] -> regularMain+  ["--hydration-probe"] -> hydrationProbeMain+  arguments -> fail ("unexpected arguments: " <> show arguments)++regularMain :: IO ()+regularMain =+  withMigratedSuite $ \fixture ->+    withFreshResourceStore fixture $ \(_storeHandle, StoreRunner runStore) -> do+      incidentId <- either (fail . show) pure (mkIncidentId incidentKey)+      emptyId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn03r")+      let acknowledged = ResponderAcked incidentId observedAt+          source = recorded sourceUuid1 1 "ResponderAcked" acknowledged+          sourceId = source.eventId+          targetName = StreamName ("incident-" <> incidentKey)+          targetStream = Stream.entityStream incidentCategory incidentKey+          dispatchId = Reaction.deterministicReactionCommandId incidentEscalationProcessName incidentKey sourceId targetName 0+          targetCommand = Target.AcknowledgeIncident (Target.AcknowledgeIncidentData incidentId)++      assert "accepted-only dispatch is separated from unconditional cancel" $ case incidentEscalationReact acknowledged of+        Reaction.AdvanceReaction+          { followUps = [Reaction.FollowCancel _],+            onAccepted = [Reaction.FollowDispatch (PMCommand _ (Target.AcknowledgeIncident {}))]+          } -> True+        _ -> False++      -- Seed the target write under the exact generated identity. The manager+      -- then appends the missing saga witness and recovers the target as a+      -- benign duplicate: the partial-success retry contract.+      _ <- expectRight =<< runStore (runCommand (defaultRunCommandOptions {eventIds = [dispatchId]}) incidentEventStream targetStream targetCommand)+      first <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentEscalationProcessManager source acknowledged)+      firstResult <- expectRight first+      assert "partial target success completes only the missing saga write" $ case firstResult.commandResults of+        [PMCommandDuplicate observedId] -> observedId == dispatchId+        _ -> False+      assert "accepted cancel statement records no changed absent timer" (firstResult.timerEffects == Reaction.ReactionTimerEffects 1 0 0)++      replay <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentEscalationProcessManager source acknowledged)+      replayResult <- expectRight replay+      assert "accepted redelivery skips timer SQL" (replayResult.timerEffects == Reaction.ReactionTimerEffects 0 0 0)+      assert "accepted redelivery retries fan-out by stable identity" $ case replayResult.commandResults of+        [PMCommandDuplicate observedId] -> observedId == dispatchId+        _ -> False++      sagaEvents <- expectRight =<< runStore (Store.readStreamForward (StreamName ("escalation-" <> incidentKey)) (StreamVersion 0) 10)+      targetEvents <- expectRight =<< runStore (Store.readStreamForward targetName (StreamVersion 0) 10)+      assert "recorded saga event authorizes exactly one accepted-only target" (Vector.length sagaEvents == 1 && Vector.length targetEvents == 1)++      let noAdvance = IncidentNoted emptyId+          noAdvanceSource = recorded sourceUuid2 2 "IncidentNoted" noAdvance+      noAdvanceOutcome <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentEscalationProcessManager noAdvanceSource noAdvance)+      noAdvanceResult <- expectRight noAdvanceOutcome+      assert "no-advance performs no accepted-only effects" $ case noAdvanceResult.managerResult of+        Reaction.ReactionNotAdvanced -> null noAdvanceResult.commandResults && noAdvanceResult.timerEffects == Reaction.ReactionTimerEffects 0 0 0+        _ -> False+      absentSaga <- expectRight =<< runStore (Store.getStream (StreamName ("escalation-" <> incidentIdText emptyId)))+      assert "no-advance does not create or hydrate a saga stream" (absentSaga == Nothing)++      silentId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn04s")+      let reported = IncidentReported silentId Sev1 observedAt+          reportedSource = recorded sourceUuid3 3 "IncidentReported" reported+          ignored = ResponderIgnored silentId+          ignoredSource = recorded sourceUuid4 4 "ResponderIgnored" ignored+      reportedOutcome <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentEscalationProcessManager reportedSource reported)+      _ <- expectRight reportedOutcome+      silentOutcome <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentEscalationProcessManager ignoredSource ignored)+      silentResult <- expectRight silentOutcome+      assert "silent advance keeps unconditional cancellation and suppresses accepted-only dispatch" $+        null silentResult.commandResults+          && silentResult.timerEffects == Reaction.ReactionTimerEffects 1 0 1+      silentReplay <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentEscalationProcessManager ignoredSource ignored)+      silentReplayResult <- expectRight silentReplay+      assert "silent redelivery remains eligible but has no accepted-only effects" $+        null silentReplayResult.commandResults+          && silentReplayResult.timerEffects == Reaction.ReactionTimerEffects 1 0 0+      silentSaga <- expectRight =<< runStore (Store.readStreamForward (StreamName ("escalation-" <> incidentIdText silentId)) (StreamVersion 0) 10)+      silentTarget <- expectRight =<< runStore (Store.getStream (StreamName ("incident-" <> incidentIdText silentId)))+      assert "silent arm records no saga event of its own and no target event" (Vector.length silentSaga == 1 && silentTarget == Nothing)+      putStrLn "process state-authority conformance: PASS"++hydrationProbeMain :: IO ()+hydrationProbeMain =+  withMigratedSuite $ \fixture ->+    withFreshResourceStore fixture $ \(_storeHandle, StoreRunner runStore) -> do+      incidentId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn07w")+      let workerCount = 32+          input = IncidentReported incidentId Sev1 observedAt+          run index =+            runStore+              ( Reaction.runReactiveProcessManagerOnce+                  defaultRunCommandOptions+                  incidentEscalationProcessManager+                  (recorded (conflictSourceUuid index) (100 + index) "IncidentReported" input)+                  input+              )+      ready <- newEmptyMVar+      start <- newEmptyMVar+      done <- newEmptyMVar+      forM_ [0 .. workerCount - 1] $ \index -> do+        _ <- forkIO $ do+          putMVar ready ()+          readMVar start+          run index >>= putMVar done+        pure ()+      replicateM_ workerCount (takeMVar ready)+      hPutStrLn stderr "reaction-case-start state-authority-forced-conflict"+      putMVar start ()+      outcomes <- replicateM workerCount (takeMVar done)+      hPutStrLn stderr "reaction-case-end state-authority-forced-conflict"+      assert "forced conflict has at least one accepted append" (any isAccepted outcomes)+      assert "forced conflict observes an optimistic loser" (any isConflict outcomes)+      putStrLn "process state-authority hydration probe: PASS"+  where+    isAccepted = \case+      Right (Right _) -> True+      _ -> False+    isConflict = \case+      Right (Left (Reaction.ReactionCommandFailed _)) -> True+      _ -> False++conflictSourceUuid :: Int -> UUID+conflictSourceUuid index =+  UUID.V5.generateNamed+    UUID.V5.namespaceURL+    (map (fromIntegral . fromEnum) ("state-authority-conflict-" <> show index))++recorded :: (ToJSON input) => UUID -> Int -> EventTypeName -> input -> RecordedEvent+recorded eventUuid position eventName input =+  RecordedEvent+    { eventId = EventId eventUuid,+      eventType = EventType eventName,+      streamVersion = StreamVersion (fromIntegral position),+      globalPosition = GlobalPosition (fromIntegral position),+      originalStreamId = StreamId 1,+      originalVersion = StreamVersion (fromIntegral position),+      payload = Aeson.toJSON input,+      metadata = Nothing,+      causationId = Nothing,+      correlationId = Nothing,+      createdAt = observedAt+    }++type EventTypeName = Text++incidentKey :: Text+incidentKey = "inc_01h455vb4pex5vsknk084sn02q"++observedAt :: UTCTime+observedAt = UTCTime (ModifiedJulianDay 60000) (secondsToDiffTime 0)++sourceUuid1, sourceUuid2, sourceUuid3, sourceUuid4 :: UUID+sourceUuid1 = staticUuid "123e4567-e89b-72d3-a456-426614174011"+sourceUuid2 = staticUuid "123e4567-e89b-72d3-a456-426614174012"+sourceUuid3 = staticUuid "123e4567-e89b-72d3-a456-426614174013"+sourceUuid4 = staticUuid "123e4567-e89b-72d3-a456-426614174014"++staticUuid :: String -> UUID+staticUuid value = case UUID.fromString value of+  Just parsed -> parsed+  Nothing -> error "invalid static source UUID"++expectRight :: (Show problem) => Either problem value -> IO value+expectRight = either (error . show) pure++assert :: String -> Bool -> IO ()+assert label condition = unless condition (error ("process state-authority conformance failed: " <> label))
+ test/conformance-process-state-authority/keiro-dsl-cabal-fragment.context.incident-response.txt view
@@ -0,0 +1,47 @@+-- keiro-dsl build manifest for keiro-dsl/test/fixtures/process-state-authority.keiro+-- Paste the complete fragment below into the consuming Cabal stanza.+-- The generated layer is overwritten on every scaffold; hole modules are+-- create-if-absent (filled by hand).++default-language: GHC2024+default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings++other-modules:+    Generated.IncidentResponse.BehaviorSourceMap+    Generated.IncidentResponse.Escalation.BehaviorContract+    Generated.IncidentResponse.Escalation.Codec+    Generated.IncidentResponse.Escalation.Domain+    Generated.IncidentResponse.Escalation.EventStream+    Generated.IncidentResponse.Escalation.Harness+    Generated.IncidentResponse.Escalation.Projection+    Generated.IncidentResponse.Escalation.Transducer+    Generated.IncidentResponse.Incident.BehaviorContract+    Generated.IncidentResponse.Incident.Codec+    Generated.IncidentResponse.Incident.Domain+    Generated.IncidentResponse.Incident.EventStream+    Generated.IncidentResponse.Incident.Harness+    Generated.IncidentResponse.Incident.Projection+    Generated.IncidentResponse.Incident.Transducer+    Generated.IncidentResponse.IncidentEscalation.Input+    Generated.IncidentResponse.IncidentEscalation.Process+    Generated.IncidentResponse.IncidentEscalation.ProcessHarness+    Generated.IncidentResponse.Nominals+    Generated.IncidentResponse.Nominals.Internal+    Generated.IncidentResponse.ReplayAudit+    IncidentResponse.Escalation.BehaviorHoles+    IncidentResponse.Incident.BehaviorHoles+    IncidentResponse.IncidentEscalation.ProcessHoles++build-depends:+    , aeson+    , base+    , keiki+    , keiro+    , shibuya-core+    , text+    , time+    , uuid
+ test/conformance-process-state-authority/keiro-dsl-ledger.context.incident-response.txt view
@@ -0,0 +1,72 @@+keiro-dsl scaffold record v1+spec: keiro-dsl/test/fixtures/process-state-authority.keiro+module-root: (none)+layout: prefixed+source-language {"declaredLanguageVersion":6,"effectiveLanguageVersion":6,"sourceForm":"declared"}+semantic-contract {"languageSupport":"candidate","languageVersion":6,"runtimeSemantics":"keiro-dsl/runtime-semantics/5"}+naming-edition idiomatic-v2+module-role {"family":"BehaviorSourceMap","kind":"generated","ownerKind":"context","ownerName":"context incident-response behavior source map","path":"Generated/IncidentResponse/BehaviorSourceMap.hs"}+module-role {"family":"Nominals","kind":"generated","ownerKind":"context","ownerName":"context incident-response generated nominal declarations","path":"Generated/IncidentResponse/Nominals.hs"}+module-role {"family":"Internal","kind":"generated","ownerKind":"context","ownerName":"context incident-response generated nominal ID internals","path":"Generated/IncidentResponse/Nominals/Internal.hs"}+module-role {"family":"ReplayAudit","kind":"generated","ownerKind":"context","ownerName":"context incident-response replay-audit assembly","path":"Generated/IncidentResponse/ReplayAudit.hs"}+module-role {"family":"Input","kind":"generated","ownerKind":"process","ownerName":"process input IncidentEscalation (line 9)","path":"Generated/IncidentResponse/IncidentEscalation/Input.hs"}+module-role {"family":"Process","kind":"generated","ownerKind":"process","ownerName":"process reaction IncidentEscalation (line 9)","path":"Generated/IncidentResponse/IncidentEscalation/Process.hs"}+module-role {"family":"ProcessHoles","kind":"hole","ownerKind":"process","ownerName":"process decoder IncidentEscalation (line 9)","path":"IncidentResponse/IncidentEscalation/ProcessHoles.hs"}+module-role {"family":"ProcessHarness","kind":"generated","ownerKind":"process","ownerName":"process IncidentEscalation (line 9)","path":"Generated/IncidentResponse/IncidentEscalation/ProcessHarness.hs"}+module-role {"family":"Domain","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Escalation (line 62)","path":"Generated/IncidentResponse/Escalation/Domain.hs"}+module-role {"family":"Codec","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Escalation (line 62)","path":"Generated/IncidentResponse/Escalation/Codec.hs"}+module-role {"family":"Transducer","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Escalation (line 62)","path":"Generated/IncidentResponse/Escalation/Transducer.hs"}+module-role {"family":"BehaviorContract","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Escalation (line 62)","path":"Generated/IncidentResponse/Escalation/BehaviorContract.hs"}+module-role {"family":"BehaviorHoles","kind":"hole","ownerKind":"aggregate","ownerName":"aggregate behavior witnesses Escalation (line 62)","path":"IncidentResponse/Escalation/BehaviorHoles.hs"}+module-role {"family":"EventStream","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Escalation (line 62)","path":"Generated/IncidentResponse/Escalation/EventStream.hs"}+module-role {"family":"Projection","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Escalation (line 62)","path":"Generated/IncidentResponse/Escalation/Projection.hs"}+module-role {"family":"Harness","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Escalation (line 62)","path":"Generated/IncidentResponse/Escalation/Harness.hs"}+module-role {"family":"Domain","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 89)","path":"Generated/IncidentResponse/Incident/Domain.hs"}+module-role {"family":"Codec","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 89)","path":"Generated/IncidentResponse/Incident/Codec.hs"}+module-role {"family":"Transducer","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 89)","path":"Generated/IncidentResponse/Incident/Transducer.hs"}+module-role {"family":"BehaviorContract","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 89)","path":"Generated/IncidentResponse/Incident/BehaviorContract.hs"}+module-role {"family":"BehaviorHoles","kind":"hole","ownerKind":"aggregate","ownerName":"aggregate behavior witnesses Incident (line 89)","path":"IncidentResponse/Incident/BehaviorHoles.hs"}+module-role {"family":"EventStream","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 89)","path":"Generated/IncidentResponse/Incident/EventStream.hs"}+module-role {"family":"Projection","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 89)","path":"Generated/IncidentResponse/Incident/Projection.hs"}+module-role {"family":"Harness","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 89)","path":"Generated/IncidentResponse/Incident/Harness.hs"}+generated Generated/IncidentResponse/BehaviorSourceMap.hs+generated Generated/IncidentResponse/Nominals.hs+generated Generated/IncidentResponse/Nominals/Internal.hs+generated Generated/IncidentResponse/ReplayAudit.hs+generated Generated/IncidentResponse/IncidentEscalation/Input.hs+generated Generated/IncidentResponse/IncidentEscalation/Process.hs+hole IncidentResponse/IncidentEscalation/ProcessHoles.hs+generated Generated/IncidentResponse/IncidentEscalation/ProcessHarness.hs+generated Generated/IncidentResponse/Escalation/Domain.hs+generated Generated/IncidentResponse/Escalation/Codec.hs+generated Generated/IncidentResponse/Escalation/Transducer.hs+generated Generated/IncidentResponse/Escalation/BehaviorContract.hs+hole IncidentResponse/Escalation/BehaviorHoles.hs+generated Generated/IncidentResponse/Escalation/EventStream.hs+generated Generated/IncidentResponse/Escalation/Projection.hs+generated Generated/IncidentResponse/Escalation/Harness.hs+generated Generated/IncidentResponse/Incident/Domain.hs+generated Generated/IncidentResponse/Incident/Codec.hs+generated Generated/IncidentResponse/Incident/Transducer.hs+generated Generated/IncidentResponse/Incident/BehaviorContract.hs+hole IncidentResponse/Incident/BehaviorHoles.hs+generated Generated/IncidentResponse/Incident/EventStream.hs+generated Generated/IncidentResponse/Incident/Projection.hs+generated Generated/IncidentResponse/Incident/Harness.hs+id-domain id-domain|name=IncidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text+nominal-equality nominal-equality|name=EscalationNoOp|contract=keiro-dsl/nominal-equality/1|key=Text|domain=finite-text:ignored|owner=generated+nominal-equality nominal-equality|name=EscalationRejection|contract=keiro-dsl/nominal-equality/1|key=Text|domain=finite-text:invalid|owner=generated+nominal-equality nominal-equality|name=IncidentId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:inc:keiro-dsl/id-domain/typeid-v7/1|owner=generated+nominal-equality nominal-equality|name=Severity|contract=keiro-dsl/nominal-equality/1|key=Text|domain=finite-text:sev1,sev2,sev3|owner=generated+behavior {"aggregate":"Escalation","command":"NoteIgnored","evidence":"generated-authoritative","key":"behavior-v1-00b0b13023eea6f8","kind":"live-transition","outputs":[],"source":"Open"}+behavior {"aggregate":"Incident","command":"EscalateIncident","evidence":"generated-authoritative","key":"behavior-v1-0aad69728dee8fec","kind":"live-transition","outputs":[{"command":"EscalateIncident","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"Escalation","command":"NoteAcknowledged","evidence":"generated-authoritative","key":"behavior-v1-16209316858bb8c3","kind":"required-rejection","outputs":[],"source":"Dormant"}+behavior {"aggregate":"Escalation","command":"NoteRaised","evidence":"generated-authoritative","key":"behavior-v1-2144226ce8222855","kind":"live-transition","outputs":[{"command":"NoteRaised","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"Incident","command":"AcknowledgeIncident","evidence":"generated-authoritative","key":"behavior-v1-36c541281e30554e","kind":"live-transition","outputs":[{"command":"AcknowledgeIncident","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"Escalation","command":"ActivateDormant","evidence":"generated-authoritative","key":"behavior-v1-3d0e024503e32404","kind":"live-transition","outputs":[{"command":"ActivateDormant","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"Escalation","command":"NoteAcknowledged","evidence":"generated-authoritative","key":"behavior-v1-65795e7a28345559","kind":"live-transition","outputs":[{"command":"NoteAcknowledged","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"Escalation","command":"NoteRaised","evidence":"generated-authoritative","key":"behavior-v1-75011409d18e29c3","kind":"required-rejection","outputs":[],"source":"Dormant"}+behavior {"aggregate":"Escalation","command":"ActivateDormant","evidence":"generated-authoritative","key":"behavior-v1-8f58f8301e7a66f3","kind":"required-rejection","outputs":[],"source":"Dormant"}+behavior {"aggregate":"Escalation","command":"NoteIgnored","evidence":"generated-authoritative","key":"behavior-v1-eecae8fa281fddcf","kind":"required-rejection","outputs":[],"source":"Dormant"}+process-reaction {"fingerprint":"74ccfa3e3e78a8d747546629dce80be851ec3dd2babbd7ddea34b0746f19c7c7","holeObligations":["decodeIncidentEscalationInput :: RecordedEvent -> Maybe IncidentEscalationInput"],"processName":"incident-escalation","verification":"generated-declarative","version":1}+semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
+ test/conformance-process-timers/Generated/ProcessTimers/BehaviorSourceMap.hs view
@@ -0,0 +1,33 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context process-timers behavior source map; do not edit.+module Generated.ProcessTimers.BehaviorSourceMap+  ( BehaviorSourceLocation (..)+  , behaviorSourceLocation+  , renderBehaviorSourceLocation+  ) where++import Data.Text (Text)+import Data.Text qualified as T++data BehaviorSourceLocation = BehaviorSourceLocation+  { file :: !FilePath+  , line :: !Int+  , column :: !Int+  }+  deriving stock (Eq, Ord, Show)++behaviorSourceLocation :: Text -> Maybe BehaviorSourceLocation+behaviorSourceLocation key = case key of+  "behavior-v1-48ce258ccf64ef4e" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-timers.keiro" 55 15)+  "behavior-v1-93455a87d5151176" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-timers.keiro" 61 3)+  "behavior-v1-af16dd42cbccd576" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-timers.keiro" 51 3)+  "behavior-v1-b944c85b616b9349" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-timers.keiro" 60 3)+  "behavior-v1-d66d007f74139a07" -> Just (BehaviorSourceLocation "keiro-dsl/test/fixtures/process-timers.keiro" 55 15)+  _ -> Nothing++renderBehaviorSourceLocation :: Text -> Text+renderBehaviorSourceLocation key = case behaviorSourceLocation key of+  Just location -> T.pack location.file <> ":" <> tshow location.line <> ":" <> tshow location.column+  Nothing -> "<internal invariant: missing behavior source for " <> key <> ">"++tshow :: Show value => value -> Text+tshow = T.pack . show
+ test/conformance-process-timers/Generated/ProcessTimers/Incident/BehaviorContract.hs view
@@ -0,0 +1,374 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessTimers.Incident.BehaviorContract+  ( BehaviorKey (..)+  , unBehaviorKey+  , ObligationKind (..)+  , EvidenceLevel (..)+  , GuardCoverage (..)+  , BehaviorRequirement (..)+  , RejectionClass (..)+  , LiveExpectation (..)+  , BehaviorWitness (..)+  , BehaviorFailure (..)+  , BehaviorConformanceReport (..)+  , behaviorRequirements+  , behaviorCoverageReport+  , behaviorConformancePassed+  , behaviorConformancePassedWith+  , renderBehaviorConformanceText+  ) where++import Generated.ProcessTimers.Incident.Codec (encodeIncidentEvent, parseIncidentEvent, incidentCodec)+import Generated.ProcessTimers.Incident.Domain+import Generated.ProcessTimers.Incident.Transducer (incidentTransducer)+import Generated.ProcessTimers.BehaviorSourceMap qualified as BehaviorSourceMap+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 (EdgeMode (..), EdgeRef (..), RegFile, ReplayAttribution (..), ReplayEventSpan (..), ReplaySuccess (..), StepFailure (..), StepSuccess (..), applyEventsDetailedEither, stepDetailedEither)+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+  { key :: !BehaviorKey+  , kind :: !ObligationKind+  , evidence :: !EvidenceLevel+  , guardCoverage :: !GuardCoverage+  , source :: !IncidentVertex+  , commandName :: !Text+  , expectedEdge :: !(Maybe (K.EdgeRef IncidentVertex))+  , target :: !(Maybe IncidentVertex)+  , eventKinds :: ![Text]+  }+  deriving stock (Eq, Show)++data RejectionClass = RejectNoOutgoingEdges | RejectNoMatchingEdge+  deriving stock (Eq, Show)++data LiveExpectation+  = Emits (NonEmpty IncidentEvent)+  | Rejects RejectionClass+  | NoOp+  deriving stock (Eq, Show)++data BehaviorWitness+  = Pending BehaviorKey+  | LiveWitness+      { key :: BehaviorKey+      , history :: [IncidentEvent]+      , command :: IncidentCommand+      , expected :: LiveExpectation+      }+  | ReplayWitness+      { key :: BehaviorKey+      , historyPrefix :: [IncidentEvent]+      , observedChunk :: [IncidentEvent]+      }+  deriving stock (Eq, Show)++data BehaviorFailure = BehaviorFailure+  { key :: !BehaviorKey+  , subject :: !Text+  , code :: !Text+  , detail :: !Text+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorFailure where+  toJSON behaviorFailure = object+    [ "key" .= unBehaviorKey behaviorFailure.key+    , "subject" .= behaviorFailure.subject+    , "code" .= behaviorFailure.code+    , "detail" .= behaviorFailure.detail+    ]++data BehaviorConformanceReport = BehaviorConformanceReport+  { required :: ![BehaviorKey]+  , filled :: ![BehaviorKey]+  , pending :: ![BehaviorKey]+  , missing :: ![BehaviorKey]+  , duplicate :: ![BehaviorKey]+  , stale :: ![BehaviorKey]+  , failed :: ![BehaviorFailure]+  , verified :: ![BehaviorKey]+  , unverified :: ![BehaviorKey]+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorConformanceReport where+  toJSON report = object+    [ "schema" .= ("keiro/behavior-conformance/1" :: Text)+    , "required" .= keyTexts report.required+    , "filled" .= keyTexts report.filled+    , "pending" .= keyTexts report.pending+    , "missing" .= keyTexts report.missing+    , "duplicate" .= keyTexts report.duplicate+    , "stale" .= keyTexts report.stale+    , "failed" .= report.failed+    , "verified" .= keyTexts report.verified+    , "unverified" .= keyTexts report.unverified+    ]++behaviorRequirements :: [BehaviorRequirement]+behaviorRequirements =+  [ -- IncidentEscalatedState x EscalateIncident: required rejection+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-48ce258ccf64ef4e"+      , kind = RequiredRejection+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardNotApplicable+      , source = IncidentEscalatedState+      , commandName = "EscalateIncident"+      , expectedEdge = Nothing+      , target = Nothing+      , eventKinds = []+      }+  , -- IncidentOpen x RemindIncident: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-93455a87d5151176"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = IncidentOpen+      , commandName = "RemindIncident"+      , expectedEdge = (Just (K.EdgeRef IncidentOpen 1))+      , target = Just IncidentOpen+      , eventKinds = ["IncidentReminded"]+      }+  , -- IncidentOpen x EscalateIncident: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-b944c85b616b9349"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = IncidentOpen+      , commandName = "EscalateIncident"+      , expectedEdge = (Just (K.EdgeRef IncidentOpen 0))+      , target = Just IncidentEscalatedState+      , eventKinds = ["IncidentEscalated"]+      }+  , -- IncidentEscalatedState x RemindIncident: required rejection+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-d66d007f74139a07"+      , kind = RequiredRejection+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardNotApplicable+      , source = IncidentEscalatedState+      , commandName = "RemindIncident"+      , expectedEdge = Nothing+      , target = Nothing+      , eventKinds = []+      }+  ]++behaviorCoverageReport :: [BehaviorWitness] -> BehaviorConformanceReport+behaviorCoverageReport witnesses =+  BehaviorConformanceReport+    { required = sortedKeys (Map.keys requiredByKey)+    , filled = sortedKeys [key | (key, [witness]) <- Map.toList witnessGroups, Map.member key requiredByKey, not (isPending witness)]+    , pending = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, Map.member key requiredByKey, any isPending rows]+    , missing = sortedKeys [key | key <- Map.keys requiredByKey, Map.notMember key witnessGroups]+    , duplicate = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, length rows > 1]+    , stale = sortedKeys [key | key <- Map.keys witnessGroups, Map.notMember key requiredByKey]+    , failed = sortOn (unBehaviorKey . (.key)) failures+    , verified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, proofStrength requirement]+    , unverified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, not (proofStrength requirement)]+    }+ where+  requiredByKey = Map.fromList [(requirement.key, 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.pending+    && null report.missing+    && null report.duplicate+    && null report.stale+    && null report.failed+    && (not failOnUnverified || null report.unverified)++renderBehaviorConformanceText :: BehaviorConformanceReport -> Text+renderBehaviorConformanceText report = T.unlines+  [ "behavior conformance: Incident"+  , "schema: keiro/behavior-conformance/1"+  , countLine "required" report.required+  , countLine "filled" report.filled+  , countLine "pending" report.pending+  , countLine "missing" report.missing+  , countLine "duplicate" report.duplicate+  , countLine "stale" report.stale+  , "failed: " <> tshow (length report.failed)+  , countLine "verified" report.verified+  , countLine "unverified" report.unverified+  ] <> T.unlines ["FAIL " <> unBehaviorKey behaviorFailure.key <> " " <> behaviorFailure.subject <> " [" <> behaviorFailure.code <> "] " <> behaviorFailure.detail | behaviorFailure <- report.failed]++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 -> [IncidentEvent] -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runLive requirement history command expectation = do+  settled <- settleHistory requirement "history" history+  ensure requirement (K.replaySuccessState settled == requirement.source) "history-wrong-source" "history does not settle at the required source vertex"+  ensure requirement (commandKind command == requirement.commandName) "command-mismatch" "witness command constructor does not match the required state/command cell"+  case requirement.kind 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 -> (IncidentVertex, K.RegFile IncidentRegs) -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runRejection requirement seed command expectation = case expectation of+  Emits _ -> failure requirement "expectation-kind" "a rejection requirement cannot expect emitted events"+  NoOp -> failure requirement "expectation-kind" "a rejection requirement cannot expect an accepted no-op"+  Rejects expectedClass -> case K.stepDetailedEither incidentTransducer 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 -> (IncidentVertex, K.RegFile IncidentRegs) -> IncidentCommand -> LiveExpectation -> Either BehaviorFailure ()+runAcceptance requirement seed command expectation = case expectation of+  Rejects _ -> failure requirement "expectation-kind" "a live-transition requirement needs Emits or NoOp"+  NoOp -> case K.stepDetailedEither incidentTransducer 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"+  Emits expectedEvents -> case K.stepDetailedEither incidentTransducer 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.eventKinds) "event-envelope-mismatch" ("runtime event kinds differ from the declared ordered envelope; actual=" <> tshow (map eventKind actual) <> " expected=" <> tshow requirement.eventKinds)+      decoded <- either (failure requirement "emitted-codec-decode") Right (decodeEvents actual)+      replayed <- case K.applyEventsDetailedEither incidentTransducer 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)++checkAcceptedEnvelope :: BehaviorRequirement -> K.StepSuccess IncidentRegs IncidentVertex IncidentEvent -> 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.expectedEdge) "edge-attribution" ("runtime selected a different guarded sibling; actual=" <> tshow (Just (K.stepSuccessEdge success)) <> " expected=" <> tshow requirement.expectedEdge)+  ensure requirement (Just (K.stepSuccessState success) == requirement.target) "target-mismatch" ("runtime reached a different target vertex; actual=" <> tshow (Just (K.stepSuccessState success)) <> " expected=" <> tshow requirement.target)++runReplay :: BehaviorRequirement -> [IncidentEvent] -> [IncidentEvent] -> Either BehaviorFailure ()+runReplay requirement prefix chunk = case requirement.kind of+  ReplayTransition -> do+    settled <- settleHistory requirement "history-prefix" prefix+    ensure requirement (K.replaySuccessState settled == requirement.source) "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 incidentTransducer (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.target) "target-mismatch" ("replay chunk reached a different target vertex; actual=" <> tshow (Just (K.replaySuccessState replayed)) <> " expected=" <> tshow requirement.target)+    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 IncidentVertex] -> Either BehaviorFailure ()+checkSingleAttribution requirement expectedMode eventCount trace = case trace of+  [attribution] -> do+    ensure requirement (Just (K.replayAttributionEdge attribution) == requirement.expectedEdge) "replay-edge-attribution" ("replay selected a different edge; actual=" <> tshow (Just (K.replayAttributionEdge attribution)) <> " expected=" <> tshow requirement.expectedEdge)+    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.source) "replay-source-attribution" ("replay attribution starts at the wrong source; actual=" <> tshow (K.replayAttributionSource attribution) <> " expected=" <> tshow requirement.source)+    ensure requirement (Just (K.replayAttributionTarget attribution) == requirement.target) "replay-target-attribution" ("replay attribution ends at the wrong target; actual=" <> tshow (Just (K.replayAttributionTarget attribution)) <> " expected=" <> tshow requirement.target)+    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 -> [IncidentEvent] -> Either BehaviorFailure (K.ReplaySuccess IncidentRegs IncidentVertex)+settleHistory requirement label history = do+  decoded <- either (failure requirement (label <> "-codec-decode")) Right (decodeEvents history)+  case K.applyEventsDetailedEither incidentTransducer (IncidentOpen, initialIncidentRegs) decoded of+    Left replayFailure -> failure requirement (label <> "-replay-failed") (tshow replayFailure)+    Right replaySuccess -> Right replaySuccess++decodeEvents :: [IncidentEvent] -> Either Text [IncidentEvent]+decodeEvents = traverse (\event -> parseIncidentEvent (Codec.eventType incidentCodec event) (encodeIncidentEvent event))++commandKind :: IncidentCommand -> Text+commandKind command = case command of+  EscalateIncident _ -> "EscalateIncident"+  RemindIncident _ -> "RemindIncident"++eventKind :: IncidentEvent -> Text+eventKind event = case Codec.eventType incidentCodec event of Codec.EventType tag -> tag++regsEqual :: K.RegFile IncidentRegs -> K.RegFile IncidentRegs -> Bool+regsEqual _ _ = True++proofStrength :: BehaviorRequirement -> Bool+proofStrength requirement =+  requirement.evidence == GeneratedAuthoritative+    && requirement.guardCoverage `elem` [GuardTotal, GuardNotApplicable]++behaviorWitnessKey :: BehaviorWitness -> BehaviorKey+behaviorWitnessKey witness = case witness of+  Pending key -> key+  LiveWitness { key = key } -> key+  ReplayWitness { key = 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.key+        (tshow requirement.source <> " x " <> requirement.commandName <> ": " <> kindPhrase <> " (" <> BehaviorSourceMap.renderBehaviorSourceLocation (unBehaviorKey requirement.key) <> ")")+        code+        detail+    )+ where+  kindPhrase = case requirement.kind 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
+ test/conformance-process-timers/Generated/ProcessTimers/Incident/Codec.hs view
@@ -0,0 +1,77 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessTimers.Incident.Codec (+    incidentCodec,+    parseIncidentEvent,+    encodeIncidentEvent,+) where++import Generated.ProcessTimers.Incident.Domain+import Generated.ProcessTimers.Nominals (incidentIdText)+import Generated.ProcessTimers.Nominals.Internal (unsafeIncidentIdFromLegacyText)+import Data.Aeson (Value, object, withObject, (.:), (.=))+import Data.Aeson.Types (parseEither)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text (Text)+import qualified Data.Text as T+import Keiro.Codec (Codec (..), EventType (..))++++++incidentEventTypes :: NonEmpty EventType+incidentEventTypes = EventType "IncidentEscalated" :| [EventType "IncidentReminded"]++incidentCodec :: Codec IncidentEvent+incidentCodec =+  Codec+    { eventTypes = incidentEventTypes+    , eventType = \case+        IncidentEscalated{} -> EventType "IncidentEscalated"+        IncidentReminded{} -> EventType "IncidentReminded"+    , schemaVersion = 1+    , encode = encodeIncidentEvent+    , decode = parseIncidentEvent+    , upcasters = []+    }++encodeIncidentEvent :: IncidentEvent -> Value+encodeIncidentEvent = \case+  IncidentEscalated payload ->+    object+      [ "kind" .= ("IncidentEscalated" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]+  IncidentReminded payload ->+    object+      [ "kind" .= ("IncidentReminded" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]++parseIncidentEvent :: EventType -> Value -> Either Text IncidentEvent+parseIncidentEvent (EventType tag) = mapLeftText . parseEither (withObject "IncidentEvent" go)+  where+    go o = do+      case tag of+        "IncidentEscalated" ->+          IncidentEscalated+            <$> ( IncidentEscalatedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        "IncidentReminded" ->+          IncidentReminded+            <$> ( IncidentRemindedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes incidentEventTypes)++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
+ test/conformance-process-timers/Generated/ProcessTimers/Incident/Domain.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE TemplateHaskell #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessTimers.Incident.Domain where++import GHC.Generics (Generic)+import Keiki.Core (RegFile (..))+import Generated.ProcessTimers.Nominals (IncidentId)+import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)++data IncidentVertex = IncidentOpen | IncidentEscalatedState+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)++data EscalateIncidentData = EscalateIncidentData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data RemindIncidentData = RemindIncidentData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentCommand = EscalateIncident !EscalateIncidentData+  | RemindIncident !RemindIncidentData+  deriving stock (Generic, Eq, Show)++data IncidentEscalatedData = IncidentEscalatedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentRemindedData = IncidentRemindedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentEvent = IncidentEscalated !IncidentEscalatedData+  | IncidentReminded !IncidentRemindedData+  deriving stock (Generic, Eq, Show)++type IncidentRegs =+  '[]++initialIncidentRegs :: RegFile IncidentRegs+initialIncidentRegs =+  RNil++$(deriveAggregateCtorsAll ''IncidentCommand ''IncidentRegs)++++$(deriveWireCtorsAll ''IncidentEvent)
+ test/conformance-process-timers/Generated/ProcessTimers/Incident/EventStream.hs view
@@ -0,0 +1,49 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessTimers.Incident.EventStream+  ( incidentCategory+  , incidentCommandCategory+  , incidentEventStream+  , incidentEventStreamDef+  , IncidentEventStream+  , IncidentEventStreamDef+  ) where++import Generated.ProcessTimers.Incident.Domain+import Generated.ProcessTimers.Incident.Codec (incidentCodec)+import Generated.ProcessTimers.Incident.Transducer (incidentTransducer)+import Keiki.Core (HsPred)+import Keiro.EventStream (EventStream (..), SnapshotPolicy (..))+import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow)+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.+incidentCategory :: Stream.StreamCategory IncidentEventStreamDef+incidentCategory = Stream.categoryUnsafe "incident"++-- The same category text, typed for command envelopes such as PMCommand.+incidentCommandCategory :: Stream.StreamCategory IncidentCommand+incidentCommandCategory = Stream.categoryUnsafe "incident"++type IncidentEventStreamDef =+  EventStream (HsPred IncidentRegs IncidentCommand) IncidentRegs IncidentVertex IncidentCommand IncidentEvent++type IncidentEventStream =+  ValidatedEventStream (HsPred IncidentRegs IncidentCommand) IncidentRegs IncidentVertex IncidentCommand IncidentEvent++incidentEventStreamDef :: IncidentEventStreamDef+incidentEventStreamDef =+  EventStream+    { transducer = incidentTransducer,+      initialState = IncidentOpen,+      initialRegisters = initialIncidentRegs,+      eventCodec = incidentCodec,+      resolveStreamName = Stream.streamName,+      snapshotPolicy = Never,+      stateCodec = Nothing+    }++incidentEventStream :: IncidentEventStream+incidentEventStream =+  mkEventStreamOrThrow "Incident" incidentEventStreamDef
+ test/conformance-process-timers/Generated/ProcessTimers/Incident/Harness.hs view
@@ -0,0 +1,87 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessTimers.Incident.Harness (harnessAssertions) where++import Generated.ProcessTimers.Incident.Domain+import Generated.ProcessTimers.Incident.Codec (encodeIncidentEvent, parseIncidentEvent, incidentCodec)+import Generated.ProcessTimers.Incident.Transducer (incidentTransducer)+import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)+import Keiro.Codec (eventType)+import Generated.ProcessTimers.Nominals (IncidentId, parseIncidentId)++-- | (label, passed). A driver runs these and exits non-zero on any False,+-- naming the failing assertion. Filling a hole wrongly turns a specific+-- entry False; the scaffold cannot.+harnessAssertions :: [(String, Bool)]+harnessAssertions =+  [ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions incidentTransducer))+  -- clock-free: spec samples no wall clock (verified at scaffold time)+  , ("golden round-trip: IncidentEscalated", roundTrips sampleEventIncidentEscalated)+  , ("golden round-trip: IncidentReminded", roundTrips sampleEventIncidentReminded)+  , ("accepts EscalateIncident from IncidentOpen", acceptEscalateIncident)+  , ("accepts RemindIncident from IncidentOpen", acceptRemindIncident)+  ]+  ++ forwardReplayEscalateIncident+  ++ forwardReplayRemindIncident++roundTrips :: IncidentEvent -> Bool+roundTrips e = parseIncidentEvent (eventType incidentCodec e) (encodeIncidentEvent e) == Right e++sampleIncidentId :: IncidentId+sampleIncidentId =+  case parseIncidentId "inc_01h455vb4pex5vsknk084sn02q" of+    Right parsed -> parsed+    Left problem -> error (show problem)++sampleEventIncidentEscalated :: IncidentEvent+sampleEventIncidentEscalated = IncidentEscalated (IncidentEscalatedData sampleIncidentId)++sampleEventIncidentReminded :: IncidentEvent+sampleEventIncidentReminded = IncidentReminded (IncidentRemindedData sampleIncidentId)++acceptEscalateIncident :: Bool+acceptEscalateIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (EscalateIncident (EscalateIncidentData sampleIncidentId)) of+    Just (v, _, _) -> v == IncidentEscalatedState+    Nothing -> False++acceptRemindIncident :: Bool+acceptRemindIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (RemindIncident (RemindIncidentData sampleIncidentId)) of+    Just (v, _, _) -> v == IncidentOpen+    Nothing -> False++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayEscalateIncident :: [(String, Bool)]+forwardReplayEscalateIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (EscalateIncident (EscalateIncidentData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseIncidentEvent (eventType incidentCodec event) (encodeIncidentEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither incidentTransducer (IncidentOpen, initialIncidentRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: EscalateIncident from IncidentOpen -- "++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayRemindIncident :: [(String, Bool)]+forwardReplayRemindIncident =+  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (RemindIncident (RemindIncidentData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseIncidentEvent (eventType incidentCodec event) (encodeIncidentEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither incidentTransducer (IncidentOpen, initialIncidentRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: RemindIncident from IncidentOpen -- "
+ test/conformance-process-timers/Generated/ProcessTimers/Incident/Projection.hs view
@@ -0,0 +1,4 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessTimers.Incident.Projection () where++-- No projection declarations are present; this module keeps the generated manifest inventory total.
+ test/conformance-process-timers/Generated/ProcessTimers/Incident/Transducer.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE QualifiedDo #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.+module Generated.ProcessTimers.Incident.Transducer+  ( incidentTransducer+  , incidentFoldFingerprint+  , BehaviorOwnership (..)+  , incidentPredicateVerifications+  ) where++import Generated.ProcessTimers.Incident.Domain+import Data.Text (Text)+import Keiki.Builder qualified as B+import Keiki.Core (HsPred, SymTransducer)+import Keiki.Core qualified as K+import Keiki.Symbolic qualified as S++incidentTransducer+  :: SymTransducer+       (HsPred IncidentRegs IncidentCommand)+       IncidentRegs+       IncidentVertex+       IncidentCommand+       IncidentEvent+incidentTransducer =+  B.buildTransducer IncidentOpen initialIncidentRegs isTerminal do+    B.from IncidentOpen do+      B.onCmd inCtorEscalateIncident $ \d -> B.do+        B.emit wireIncidentEscalated (IncidentEscalatedTermFields+          { incidentId = d.incidentId+          })+        B.goto IncidentEscalatedState+      B.onCmd inCtorRemindIncident $ \d -> B.do+        B.emit wireIncidentReminded (IncidentRemindedTermFields+          { incidentId = d.incidentId+          })+        B.goto IncidentOpen+ where+  isTerminal = \case++    _ -> False++incidentFoldFingerprint :: Text+incidentFoldFingerprint = "02e08b4a7c1ca3151b93124ec044b785"++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.+incidentPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]+incidentPredicateVerifications = sequence+  [ verifyTransition "transition1OpenEscalateIncident" GeneratedOwned IncidentOpen 0+  , verifyTransition "transition2OpenRemindIncident" GeneratedOwned IncidentOpen 1+  ]+ where+  verifyTransition label owner source edgeIndex =+    case drop edgeIndex (K.edgesOut incidentTransducer source) of+      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate+      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/BehaviorContract.hs view
@@ -0,0 +1,337 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessTimers.IncidentSaga.BehaviorContract+  ( BehaviorKey (..)+  , unBehaviorKey+  , ObligationKind (..)+  , EvidenceLevel (..)+  , GuardCoverage (..)+  , BehaviorRequirement (..)+  , RejectionClass (..)+  , LiveExpectation (..)+  , BehaviorWitness (..)+  , BehaviorFailure (..)+  , BehaviorConformanceReport (..)+  , behaviorRequirements+  , behaviorCoverageReport+  , behaviorConformancePassed+  , behaviorConformancePassedWith+  , renderBehaviorConformanceText+  ) where++import Generated.ProcessTimers.IncidentSaga.Codec (encodeIncidentSagaEvent, parseIncidentSagaEvent, incidentSagaCodec)+import Generated.ProcessTimers.IncidentSaga.Domain+import Generated.ProcessTimers.IncidentSaga.Transducer (incidentSagaTransducer)+import Generated.ProcessTimers.BehaviorSourceMap qualified as BehaviorSourceMap+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 (EdgeMode (..), EdgeRef (..), RegFile, ReplayAttribution (..), ReplayEventSpan (..), ReplaySuccess (..), StepFailure (..), StepSuccess (..), applyEventsDetailedEither, stepDetailedEither)+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+  { key :: !BehaviorKey+  , kind :: !ObligationKind+  , evidence :: !EvidenceLevel+  , guardCoverage :: !GuardCoverage+  , source :: !IncidentSagaVertex+  , commandName :: !Text+  , expectedEdge :: !(Maybe (K.EdgeRef IncidentSagaVertex))+  , target :: !(Maybe IncidentSagaVertex)+  , eventKinds :: ![Text]+  }+  deriving stock (Eq, Show)++data RejectionClass = RejectNoOutgoingEdges | RejectNoMatchingEdge+  deriving stock (Eq, Show)++data LiveExpectation+  = Emits (NonEmpty IncidentSagaEvent)+  | Rejects RejectionClass+  | NoOp+  deriving stock (Eq, Show)++data BehaviorWitness+  = Pending BehaviorKey+  | LiveWitness+      { key :: BehaviorKey+      , history :: [IncidentSagaEvent]+      , command :: IncidentSagaCommand+      , expected :: LiveExpectation+      }+  | ReplayWitness+      { key :: BehaviorKey+      , historyPrefix :: [IncidentSagaEvent]+      , observedChunk :: [IncidentSagaEvent]+      }+  deriving stock (Eq, Show)++data BehaviorFailure = BehaviorFailure+  { key :: !BehaviorKey+  , subject :: !Text+  , code :: !Text+  , detail :: !Text+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorFailure where+  toJSON behaviorFailure = object+    [ "key" .= unBehaviorKey behaviorFailure.key+    , "subject" .= behaviorFailure.subject+    , "code" .= behaviorFailure.code+    , "detail" .= behaviorFailure.detail+    ]++data BehaviorConformanceReport = BehaviorConformanceReport+  { required :: ![BehaviorKey]+  , filled :: ![BehaviorKey]+  , pending :: ![BehaviorKey]+  , missing :: ![BehaviorKey]+  , duplicate :: ![BehaviorKey]+  , stale :: ![BehaviorKey]+  , failed :: ![BehaviorFailure]+  , verified :: ![BehaviorKey]+  , unverified :: ![BehaviorKey]+  }+  deriving stock (Eq, Show)++instance ToJSON BehaviorConformanceReport where+  toJSON report = object+    [ "schema" .= ("keiro/behavior-conformance/1" :: Text)+    , "required" .= keyTexts report.required+    , "filled" .= keyTexts report.filled+    , "pending" .= keyTexts report.pending+    , "missing" .= keyTexts report.missing+    , "duplicate" .= keyTexts report.duplicate+    , "stale" .= keyTexts report.stale+    , "failed" .= report.failed+    , "verified" .= keyTexts report.verified+    , "unverified" .= keyTexts report.unverified+    ]++behaviorRequirements :: [BehaviorRequirement]+behaviorRequirements =+  [ -- IncidentSagaOpen x RecordIncident: live transition+    BehaviorRequirement+      { key = BehaviorKey "behavior-v1-af16dd42cbccd576"+      , kind = LiveTransition+      , evidence = GeneratedAuthoritative+      , guardCoverage = GuardTotal+      , source = IncidentSagaOpen+      , commandName = "RecordIncident"+      , expectedEdge = (Just (K.EdgeRef IncidentSagaOpen 0))+      , target = Just IncidentSagaOpen+      , eventKinds = ["IncidentRecorded"]+      }+  ]++behaviorCoverageReport :: [BehaviorWitness] -> BehaviorConformanceReport+behaviorCoverageReport witnesses =+  BehaviorConformanceReport+    { required = sortedKeys (Map.keys requiredByKey)+    , filled = sortedKeys [key | (key, [witness]) <- Map.toList witnessGroups, Map.member key requiredByKey, not (isPending witness)]+    , pending = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, Map.member key requiredByKey, any isPending rows]+    , missing = sortedKeys [key | key <- Map.keys requiredByKey, Map.notMember key witnessGroups]+    , duplicate = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, length rows > 1]+    , stale = sortedKeys [key | key <- Map.keys witnessGroups, Map.notMember key requiredByKey]+    , failed = sortOn (unBehaviorKey . (.key)) failures+    , verified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, proofStrength requirement]+    , unverified = sortedKeys [requirement.key | (requirement, Right ()) <- executions, not (proofStrength requirement)]+    }+ where+  requiredByKey = Map.fromList [(requirement.key, 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.pending+    && null report.missing+    && null report.duplicate+    && null report.stale+    && null report.failed+    && (not failOnUnverified || null report.unverified)++renderBehaviorConformanceText :: BehaviorConformanceReport -> Text+renderBehaviorConformanceText report = T.unlines+  [ "behavior conformance: IncidentSaga"+  , "schema: keiro/behavior-conformance/1"+  , countLine "required" report.required+  , countLine "filled" report.filled+  , countLine "pending" report.pending+  , countLine "missing" report.missing+  , countLine "duplicate" report.duplicate+  , countLine "stale" report.stale+  , "failed: " <> tshow (length report.failed)+  , countLine "verified" report.verified+  , countLine "unverified" report.unverified+  ] <> T.unlines ["FAIL " <> unBehaviorKey behaviorFailure.key <> " " <> behaviorFailure.subject <> " [" <> behaviorFailure.code <> "] " <> behaviorFailure.detail | behaviorFailure <- report.failed]++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 -> [IncidentSagaEvent] -> IncidentSagaCommand -> LiveExpectation -> Either BehaviorFailure ()+runLive requirement history command expectation = do+  settled <- settleHistory requirement "history" history+  ensure requirement (K.replaySuccessState settled == requirement.source) "history-wrong-source" "history does not settle at the required source vertex"+  ensure requirement (commandKind command == requirement.commandName) "command-mismatch" "witness command constructor does not match the required state/command cell"+  case requirement.kind 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 -> (IncidentSagaVertex, K.RegFile IncidentSagaRegs) -> IncidentSagaCommand -> LiveExpectation -> Either BehaviorFailure ()+runRejection requirement seed command expectation = case expectation of+  Emits _ -> failure requirement "expectation-kind" "a rejection requirement cannot expect emitted events"+  NoOp -> failure requirement "expectation-kind" "a rejection requirement cannot expect an accepted no-op"+  Rejects expectedClass -> case K.stepDetailedEither incidentSagaTransducer 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 -> (IncidentSagaVertex, K.RegFile IncidentSagaRegs) -> IncidentSagaCommand -> LiveExpectation -> Either BehaviorFailure ()+runAcceptance requirement seed command expectation = case expectation of+  Rejects _ -> failure requirement "expectation-kind" "a live-transition requirement needs Emits or NoOp"+  NoOp -> case K.stepDetailedEither incidentSagaTransducer 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"+  Emits expectedEvents -> case K.stepDetailedEither incidentSagaTransducer 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.eventKinds) "event-envelope-mismatch" ("runtime event kinds differ from the declared ordered envelope; actual=" <> tshow (map eventKind actual) <> " expected=" <> tshow requirement.eventKinds)+      decoded <- either (failure requirement "emitted-codec-decode") Right (decodeEvents actual)+      replayed <- case K.applyEventsDetailedEither incidentSagaTransducer 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)++checkAcceptedEnvelope :: BehaviorRequirement -> K.StepSuccess IncidentSagaRegs IncidentSagaVertex IncidentSagaEvent -> 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.expectedEdge) "edge-attribution" ("runtime selected a different guarded sibling; actual=" <> tshow (Just (K.stepSuccessEdge success)) <> " expected=" <> tshow requirement.expectedEdge)+  ensure requirement (Just (K.stepSuccessState success) == requirement.target) "target-mismatch" ("runtime reached a different target vertex; actual=" <> tshow (Just (K.stepSuccessState success)) <> " expected=" <> tshow requirement.target)++runReplay :: BehaviorRequirement -> [IncidentSagaEvent] -> [IncidentSagaEvent] -> Either BehaviorFailure ()+runReplay requirement prefix chunk = case requirement.kind of+  ReplayTransition -> do+    settled <- settleHistory requirement "history-prefix" prefix+    ensure requirement (K.replaySuccessState settled == requirement.source) "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 incidentSagaTransducer (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.target) "target-mismatch" ("replay chunk reached a different target vertex; actual=" <> tshow (Just (K.replaySuccessState replayed)) <> " expected=" <> tshow requirement.target)+    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 IncidentSagaVertex] -> Either BehaviorFailure ()+checkSingleAttribution requirement expectedMode eventCount trace = case trace of+  [attribution] -> do+    ensure requirement (Just (K.replayAttributionEdge attribution) == requirement.expectedEdge) "replay-edge-attribution" ("replay selected a different edge; actual=" <> tshow (Just (K.replayAttributionEdge attribution)) <> " expected=" <> tshow requirement.expectedEdge)+    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.source) "replay-source-attribution" ("replay attribution starts at the wrong source; actual=" <> tshow (K.replayAttributionSource attribution) <> " expected=" <> tshow requirement.source)+    ensure requirement (Just (K.replayAttributionTarget attribution) == requirement.target) "replay-target-attribution" ("replay attribution ends at the wrong target; actual=" <> tshow (Just (K.replayAttributionTarget attribution)) <> " expected=" <> tshow requirement.target)+    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 -> [IncidentSagaEvent] -> Either BehaviorFailure (K.ReplaySuccess IncidentSagaRegs IncidentSagaVertex)+settleHistory requirement label history = do+  decoded <- either (failure requirement (label <> "-codec-decode")) Right (decodeEvents history)+  case K.applyEventsDetailedEither incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) decoded of+    Left replayFailure -> failure requirement (label <> "-replay-failed") (tshow replayFailure)+    Right replaySuccess -> Right replaySuccess++decodeEvents :: [IncidentSagaEvent] -> Either Text [IncidentSagaEvent]+decodeEvents = traverse (\event -> parseIncidentSagaEvent (Codec.eventType incidentSagaCodec event) (encodeIncidentSagaEvent event))++commandKind :: IncidentSagaCommand -> Text+commandKind command = case command of+  RecordIncident _ -> "RecordIncident"++eventKind :: IncidentSagaEvent -> Text+eventKind event = case Codec.eventType incidentSagaCodec event of Codec.EventType tag -> tag++regsEqual :: K.RegFile IncidentSagaRegs -> K.RegFile IncidentSagaRegs -> Bool+regsEqual _ _ = True++proofStrength :: BehaviorRequirement -> Bool+proofStrength requirement =+  requirement.evidence == GeneratedAuthoritative+    && requirement.guardCoverage `elem` [GuardTotal, GuardNotApplicable]++behaviorWitnessKey :: BehaviorWitness -> BehaviorKey+behaviorWitnessKey witness = case witness of+  Pending key -> key+  LiveWitness { key = key } -> key+  ReplayWitness { key = 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.key+        (tshow requirement.source <> " x " <> requirement.commandName <> ": " <> kindPhrase <> " (" <> BehaviorSourceMap.renderBehaviorSourceLocation (unBehaviorKey requirement.key) <> ")")+        code+        detail+    )+ where+  kindPhrase = case requirement.kind 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
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/Codec.hs view
@@ -0,0 +1,66 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessTimers.IncidentSaga.Codec (+    incidentSagaCodec,+    parseIncidentSagaEvent,+    encodeIncidentSagaEvent,+) where++import Generated.ProcessTimers.IncidentSaga.Domain+import Generated.ProcessTimers.Nominals (incidentIdText)+import Generated.ProcessTimers.Nominals.Internal (unsafeIncidentIdFromLegacyText)+import Data.Aeson (Value, object, withObject, (.:), (.=))+import Data.Aeson.Types (parseEither)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Text (Text)+import qualified Data.Text as T+import Keiro.Codec (Codec (..), EventType (..))++++++incidentSagaEventTypes :: NonEmpty EventType+incidentSagaEventTypes = EventType "IncidentRecorded" :| []++incidentSagaCodec :: Codec IncidentSagaEvent+incidentSagaCodec =+  Codec+    { eventTypes = incidentSagaEventTypes+    , eventType = \case+        IncidentRecorded{} -> EventType "IncidentRecorded"+    , schemaVersion = 1+    , encode = encodeIncidentSagaEvent+    , decode = parseIncidentSagaEvent+    , upcasters = []+    }++encodeIncidentSagaEvent :: IncidentSagaEvent -> Value+encodeIncidentSagaEvent = \case+  IncidentRecorded payload ->+    object+      [ "kind" .= ("IncidentRecorded" :: Text)+      , "incidentId" .= incidentIdText payload.incidentId+      ]++parseIncidentSagaEvent :: EventType -> Value -> Either Text IncidentSagaEvent+parseIncidentSagaEvent (EventType tag) = mapLeftText . parseEither (withObject "IncidentSagaEvent" go)+  where+    go o = do+      case tag of+        "IncidentRecorded" ->+          IncidentRecorded+            <$> ( IncidentRecordedData+                    <$> (unsafeIncidentIdFromLegacyText <$> o .: "incidentId")+                )+        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes incidentSagaEventTypes)++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
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/Domain.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessTimers.IncidentSaga.Domain where++import GHC.Generics (Generic)+import Keiki.Core (RegFile (..))+import Generated.ProcessTimers.Nominals (IncidentId)+import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)++data IncidentSagaVertex = IncidentSagaOpen+  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)++data RecordIncidentData = RecordIncidentData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentSagaCommand = RecordIncident !RecordIncidentData+  deriving stock (Generic, Eq, Show)++data IncidentRecordedData = IncidentRecordedData+  { incidentId :: !IncidentId+  }+  deriving stock (Generic, Eq, Show)++data IncidentSagaEvent = IncidentRecorded !IncidentRecordedData+  deriving stock (Generic, Eq, Show)++type IncidentSagaRegs =+  '[]++initialIncidentSagaRegs :: RegFile IncidentSagaRegs+initialIncidentSagaRegs =+  RNil++$(deriveAggregateCtorsAll ''IncidentSagaCommand ''IncidentSagaRegs)++++$(deriveWireCtorsAll ''IncidentSagaEvent)
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/EventStream.hs view
@@ -0,0 +1,49 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessTimers.IncidentSaga.EventStream+  ( incidentSagaCategory+  , incidentSagaCommandCategory+  , incidentSagaEventStream+  , incidentSagaEventStreamDef+  , IncidentSagaEventStream+  , IncidentSagaEventStreamDef+  ) where++import Generated.ProcessTimers.IncidentSaga.Domain+import Generated.ProcessTimers.IncidentSaga.Codec (incidentSagaCodec)+import Generated.ProcessTimers.IncidentSaga.Transducer (incidentSagaTransducer)+import Keiki.Core (HsPred)+import Keiro.EventStream (EventStream (..), SnapshotPolicy (..))+import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow)+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.+incidentSagaCategory :: Stream.StreamCategory IncidentSagaEventStreamDef+incidentSagaCategory = Stream.categoryUnsafe "incidentSaga"++-- The same category text, typed for command envelopes such as PMCommand.+incidentSagaCommandCategory :: Stream.StreamCategory IncidentSagaCommand+incidentSagaCommandCategory = Stream.categoryUnsafe "incidentSaga"++type IncidentSagaEventStreamDef =+  EventStream (HsPred IncidentSagaRegs IncidentSagaCommand) IncidentSagaRegs IncidentSagaVertex IncidentSagaCommand IncidentSagaEvent++type IncidentSagaEventStream =+  ValidatedEventStream (HsPred IncidentSagaRegs IncidentSagaCommand) IncidentSagaRegs IncidentSagaVertex IncidentSagaCommand IncidentSagaEvent++incidentSagaEventStreamDef :: IncidentSagaEventStreamDef+incidentSagaEventStreamDef =+  EventStream+    { transducer = incidentSagaTransducer,+      initialState = IncidentSagaOpen,+      initialRegisters = initialIncidentSagaRegs,+      eventCodec = incidentSagaCodec,+      resolveStreamName = Stream.streamName,+      snapshotPolicy = Never,+      stateCodec = Nothing+    }++incidentSagaEventStream :: IncidentSagaEventStream+incidentSagaEventStream =+  mkEventStreamOrThrow "IncidentSaga" incidentSagaEventStreamDef
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/Harness.hs view
@@ -0,0 +1,57 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessTimers.IncidentSaga.Harness (harnessAssertions) where++import Generated.ProcessTimers.IncidentSaga.Domain+import Generated.ProcessTimers.IncidentSaga.Codec (encodeIncidentSagaEvent, parseIncidentSagaEvent, incidentSagaCodec)+import Generated.ProcessTimers.IncidentSaga.Transducer (incidentSagaTransducer)+import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)+import Keiro.Codec (eventType)+import Generated.ProcessTimers.Nominals (IncidentId, parseIncidentId)++-- | (label, passed). A driver runs these and exits non-zero on any False,+-- naming the failing assertion. Filling a hole wrongly turns a specific+-- entry False; the scaffold cannot.+harnessAssertions :: [(String, Bool)]+harnessAssertions =+  [ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions incidentSagaTransducer))+  -- clock-free: spec samples no wall clock (verified at scaffold time)+  , ("golden round-trip: IncidentRecorded", roundTrips sampleEventIncidentRecorded)+  , ("accepts RecordIncident from IncidentSagaOpen", acceptRecordIncident)+  ]+  ++ forwardReplayRecordIncident++roundTrips :: IncidentSagaEvent -> Bool+roundTrips e = parseIncidentSagaEvent (eventType incidentSagaCodec e) (encodeIncidentSagaEvent e) == Right e++sampleIncidentId :: IncidentId+sampleIncidentId =+  case parseIncidentId "inc_01h455vb4pex5vsknk084sn02q" of+    Right parsed -> parsed+    Left problem -> error (show problem)++sampleEventIncidentRecorded :: IncidentSagaEvent+sampleEventIncidentRecorded = IncidentRecorded (IncidentRecordedData sampleIncidentId)++acceptRecordIncident :: Bool+acceptRecordIncident =+  case step incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) (RecordIncident (RecordIncidentData sampleIncidentId)) of+    Just (v, _, _) -> v == IncidentSagaOpen+    Nothing -> False++-- forward/replay equality (plan 147): cross the persisted codec boundary,+-- replay the emitted chain, and compare the final vertex and every register.+forwardReplayRecordIncident :: [(String, Bool)]+forwardReplayRecordIncident =+  case step incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) (RecordIncident (RecordIncidentData sampleIncidentId)) of+    Nothing -> [(prefix <> "forward step accepted", False)]+    Just (forwardVertex, _forwardRegs, emitted) ->+      case mapM (\event -> parseIncidentSagaEvent (eventType incidentSagaCodec event) (encodeIncidentSagaEvent event)) emitted of+        Left _ -> [(prefix <> "emitted chain decodes", False)]+        Right decodedEvents ->+          case applyEventsEither incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) decodedEvents of+            Left _ -> [(prefix <> "replay succeeds", False)]+            Right (replayVertex, _replayRegs) ->+              [ (prefix <> "final vertex", replayVertex == forwardVertex)+              ]+  where+    prefix = "forward/replay equality: RecordIncident from IncidentSagaOpen -- "
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/Projection.hs view
@@ -0,0 +1,4 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessTimers.IncidentSaga.Projection () where++-- No projection declarations are present; this module keeps the generated manifest inventory total.
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/Transducer.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE QualifiedDo #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.+module Generated.ProcessTimers.IncidentSaga.Transducer+  ( incidentSagaTransducer+  , incidentSagaFoldFingerprint+  , BehaviorOwnership (..)+  , incidentSagaPredicateVerifications+  ) where++import Generated.ProcessTimers.IncidentSaga.Domain+import Data.Text (Text)+import Keiki.Builder qualified as B+import Keiki.Core (HsPred, SymTransducer)+import Keiki.Core qualified as K+import Keiki.Symbolic qualified as S++incidentSagaTransducer+  :: SymTransducer+       (HsPred IncidentSagaRegs IncidentSagaCommand)+       IncidentSagaRegs+       IncidentSagaVertex+       IncidentSagaCommand+       IncidentSagaEvent+incidentSagaTransducer =+  B.buildTransducer IncidentSagaOpen initialIncidentSagaRegs isTerminal do+    B.from IncidentSagaOpen do+      B.onCmd inCtorRecordIncident $ \d -> B.do+        B.emit wireIncidentRecorded (IncidentRecordedTermFields+          { incidentId = d.incidentId+          })+        B.goto IncidentSagaOpen+ where+  isTerminal = \case++    _ -> False++incidentSagaFoldFingerprint :: Text+incidentSagaFoldFingerprint = "d897adc757953835f57708b0f13684f1"++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.+incidentSagaPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]+incidentSagaPredicateVerifications = sequence+  [ verifyTransition "transition1OpenRecordIncident" GeneratedOwned IncidentSagaOpen 0+  ]+ where+  verifyTransition label owner source edgeIndex =+    case drop edgeIndex (K.edgesOut incidentSagaTransducer source) of+      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate+      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentTimers/Input.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveAnyClass #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process input IncidentTimers; do not edit.+module Generated.ProcessTimers.IncidentTimers.Input (IncidentTimersInput (..)) where++import Data.Aeson (FromJSON, ToJSON)+import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Generated.ProcessTimers.Nominals qualified as N++data IncidentTimersInput+  = IncidentReported+      { incidentId :: !N.IncidentId+      , raisedAt :: !UTCTime+      , detail :: !Text+      }+  | ResponderAcked+      { incidentId :: !N.IncidentId+      }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromJSON, ToJSON)
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentTimers/Process.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process reaction IncidentTimers; do not edit.+module Generated.ProcessTimers.IncidentTimers.Process+  ( IncidentTimersInput (..)+  , incidentTimersProcessName+  , incidentTimersCategory+  , incidentTimersProcessWorkerOptions+  , incidentTimersReactionVersion+  , incidentTimersReactionFingerprint+  , incidentTimersReact+  , incidentTimersProcessManager+  , incidentTimersRunProcessWorker+  , EscalationPayload (..)+  , incidentTimersEscalationTimerRequest+  , ReminderPayload (..)+  , incidentTimersReminderTimerRequest+  , incidentTimersTimerWorkerOptions+  , incidentTimersFireTimer+  ) where++import Data.Text (Text)+import Data.Aeson (FromJSON, ToJSON)+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as BS+import Data.Text qualified as T+import Data.Text.Encoding (encodeUtf8)+import Data.Time (UTCTime, addUTCTime)+import Data.UUID (UUID)+import Data.UUID.V5 qualified as UUID.V5+import GHC.Generics (Generic)+import Numeric.Natural (Natural)+import Generated.ProcessTimers.IncidentTimers.Input (IncidentTimersInput (..))+import ProcessTimers.IncidentTimers.ProcessHoles (decodeIncidentTimersInput)+import Generated.ProcessTimers.IncidentSaga.Domain qualified as Saga+import Generated.ProcessTimers.IncidentSaga.EventStream (incidentSagaEventStream, IncidentSagaEventStreamDef)+import Generated.ProcessTimers.Incident.Domain qualified as Target+import Generated.ProcessTimers.Incident.EventStream (incidentCategory, incidentEventStream)+import Generated.ProcessTimers.Nominals qualified as N+import Keiro.Command (DomainCommandHandler (..), SilentDomainDecision (..))+import Keiro.Command (CommandError (..), RunCommandOptions (..), runCommand)+import Keiro.ProcessManager (confirmBenignDuplicate)+import Keiro.ProcessManager.Reaction qualified as Reaction+import Keiro.Stream qualified as Stream+import Keiro.DeterministicId (identitySeedBytes)+import Keiro.Timer (TimerId (..), TimerRequest (..), TimerWorkerOptions (..))+import Kiroku.Store.Types (EventId (..))+import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))+import Shibuya.Core.Ack (RetryDelay (..))++data EscalationPayload = EscalationPayload+  { kind :: !Text+  , incidentId :: !N.IncidentId+  , detail :: !Text+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromJSON, ToJSON)++incidentTimersEscalationTimerRequest :: Text -> UTCTime -> N.IncidentId -> Text -> TimerRequest+incidentTimersEscalationTimerRequest correlationId fireAtTime payloadIncidentId payloadDetail =+  TimerRequest+    { timerId = TimerId (reactionIdentity "incident-escalation-timer:" correlationId)+    , processManagerName = incidentTimersProcessName+    , correlationId = correlationId+    , fireAt = fireAtTime+    , payload = Aeson.toJSON (EscalationPayload { kind = "escalation", incidentId = payloadIncidentId, detail = payloadDetail })+    }++data ReminderPayload = ReminderPayload+  { kind :: !Text+  , incidentId :: !N.IncidentId+  }+  deriving stock (Generic, Eq, Show)+  deriving anyclass (FromJSON, ToJSON)++incidentTimersReminderTimerRequest :: Text -> UTCTime -> N.IncidentId -> TimerRequest+incidentTimersReminderTimerRequest correlationId fireAtTime payloadIncidentId =+  TimerRequest+    { timerId = TimerId (reactionIdentity "incident-reminder-timer:" correlationId)+    , processManagerName = incidentTimersProcessName+    , correlationId = correlationId+    , fireAt = fireAtTime+    , payload = Aeson.toJSON (ReminderPayload { kind = "reminder", incidentId = payloadIncidentId })+    }++incidentTimersProcessName :: Text+incidentTimersProcessName = "incident-timers"++incidentTimersCategory :: Stream.StreamCategory IncidentSagaEventStreamDef+incidentTimersCategory = Stream.categoryUnsafe "incidentTimers"++incidentTimersProcessWorkerOptions :: WorkerOptions es msg+incidentTimersProcessWorkerOptions =+  WorkerOptions+    { poisonPolicy = PoisonHalt,+      rejectedCommandPolicy = RejectedHalt,+      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning+      metrics = Nothing -- runtime configuration; install at call site+    }++incidentTimersTimerWorkerOptions :: TimerWorkerOptions+incidentTimersTimerWorkerOptions =+  TimerWorkerOptions+    { maxAttempts = Just 5+    , requeueStuckAfter = Just 300+    }+-- Operator dead-letter guidance: "incident timer exceeded ceiling"++incidentTimersReactionVersion :: Natural+incidentTimersReactionVersion = 1++incidentTimersReactionFingerprint :: Text+incidentTimersReactionFingerprint = "5a6afd7c9691c5716a9c7b3140b5c6c54ff8689aa6e0fbc9acf576ce56aa4904"++incidentTimersCorrelate :: IncidentTimersInput -> Text+incidentTimersCorrelate input = case input of+  IncidentReported { incidentId } -> (N.incidentIdText incidentId)+  ResponderAcked { incidentId } -> (N.incidentIdText incidentId)++incidentTimersReact :: IncidentTimersInput -> Reaction.ReactionPlan Saga.IncidentSagaCommand Target.IncidentCommand+incidentTimersReact input = case input of+  IncidentReported { incidentId, raisedAt, detail }+    -> Reaction.AdvanceReaction { command = Saga.RecordIncident (Saga.RecordIncidentData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowSchedule Reaction.Rearm (incidentTimersEscalationTimerRequest (N.incidentIdText incidentId) (addUTCTime 300 raisedAt) incidentId detail), Reaction.FollowSchedule Reaction.Once (incidentTimersReminderTimerRequest (N.incidentIdText incidentId) (addUTCTime 3600 raisedAt) incidentId)], onAccepted = [] }+  ResponderAcked { incidentId }+    -> Reaction.NoAdvance [Reaction.FollowCancel (TimerId (reactionIdentity "incident-reminder-timer:" (N.incidentIdText incidentId)))]++incidentTimersProcessManager =+  Reaction.ReactiveProcessManager+    { name = incidentTimersProcessName+    , correlate = incidentTimersCorrelate+    , sagaHandler = DomainCommandHandler { eventStream = incidentSagaEventStream, classifySilent = \_ -> SilentNoOp () }+    , streamFor = Stream.entityStream incidentTimersCategory+    , targetEventStream = incidentEventStream+    , targetProjections = const []+    , react = incidentTimersReact+    }++incidentTimersRunProcessWorker options adapter =+  Reaction.runReactiveProcessManagerWorkerWith+    incidentTimersProcessWorkerOptions+    options+    incidentTimersProcessManager+    adapter+    (\event -> case decodeIncidentTimersInput event of Nothing -> Nothing; Just input -> Just (event, input))++incidentTimersFireTimer options timer+  | timer.timerId == TimerId (reactionIdentity "incident-escalation-timer:" timer.correlationId) = incidentTimersEscalationFire options timer+  | timer.timerId == TimerId (reactionIdentity "incident-reminder-timer:" timer.correlationId) = incidentTimersReminderFire options timer+  | otherwise = pure Nothing++incidentTimersEscalationFire options timer+  | timer.processManagerName /= incidentTimersProcessName = pure Nothing+  | otherwise =+      case (Aeson.fromJSON timer.payload :: Aeson.Result EscalationPayload) of+        Aeson.Error _ -> pure Nothing+        Aeson.Success decoded -> do+          let firedId = EventId (reactionIdentity "incident-escalation-fired:" timer.correlationId)+              target = Stream.entityStream incidentCategory timer.correlationId+          result <-+            runCommand+              (options { eventIds = [firedId] })+              incidentEventStream+              target+              (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = decoded.incidentId }))+          case result of+            Right {} -> pure (Just firedId)+            Left err -> do+              benign <- confirmBenignDuplicate (Stream.streamName target) firedId err+              pure $ if benign then Just firedId else case err of+                CommandRejected -> Just firedId+                CommandAmbiguous _ -> Nothing+                _ -> Nothing++incidentTimersReminderFire options timer+  | timer.processManagerName /= incidentTimersProcessName = pure Nothing+  | otherwise =+      case (Aeson.fromJSON timer.payload :: Aeson.Result ReminderPayload) of+        Aeson.Error _ -> pure Nothing+        Aeson.Success decoded -> do+          let firedId = EventId (reactionIdentity "incident-reminder-fired:" timer.correlationId)+              target = Stream.entityStream incidentCategory timer.correlationId+          result <-+            runCommand+              (options { eventIds = [firedId] })+              incidentEventStream+              target+              (Target.RemindIncident (Target.RemindIncidentData { Target.incidentId = decoded.incidentId }))+          case result of+            Right {} -> pure (Just firedId)+            Left err -> do+              benign <- confirmBenignDuplicate (Stream.streamName target) firedId err+              pure $ if benign then Just firedId else case err of+                CommandRejected -> Just firedId+                CommandAmbiguous _ -> Nothing+                _ -> Nothing++reactionIdentity :: Text -> Text -> UUID+reactionIdentity prefix correlation =+  UUID.V5.generateNamed UUID.V5.namespaceURL (identitySeedBytes (T.concat (map field [prefix, correlation])))+  where+    field value = T.pack (show (BS.length (encodeUtf8 value))) <> ":" <> value
+ test/conformance-process-timers/Generated/ProcessTimers/IncidentTimers/ProcessHarness.hs view
@@ -0,0 +1,19 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process IncidentTimers; do not edit.+module Generated.ProcessTimers.IncidentTimers.ProcessHarness (processHarnessValues) where++-- | (label, value): the spec's deterministic process/timer decisions,+-- lowered to plain values so a driver can assert them against a committed+-- expectation. The driver's expectation is hand-written (not generated), so a+-- spec change that alters a decision diverges from it and turns a specific+-- assertion red — the spec->behaviour pin. (Live-runtime behavioural+-- conformance of the filled ProcessManager is the M5 step.)+processHarnessValues :: [(String, String)]+processHarnessValues =+  [ ("reactionOwnership", "generated-declarative")+  , ("reactionVersion", "1")+  , ("reactionFingerprint", "5a6afd7c9691c5716a9c7b3140b5c6c54ff8689aa6e0fbc9acf576ce56aa4904")+  , ("reaction.IncidentReported.0", "guard=always;advance=RecordIncident;followUps=schedule:escalation:rearm,schedule:reminder:once;accepted=")+  , ("reaction.ResponderAcked.0", "guard=always;advance=none;followUps=cancel:reminder;accepted=")+  , ("timer.escalation", "idPrefix=incident-escalation-timer:;payload=kind,incidentId,detail;fire=Incident.EscalateIncident;firedEventPrefix=incident-escalation-fired:")+  , ("timer.reminder", "idPrefix=incident-reminder-timer:;payload=kind,incidentId;fire=Incident.RemindIncident;firedEventPrefix=incident-reminder-fired:")+  ]
+ test/conformance-process-timers/Generated/ProcessTimers/Nominals.hs view
@@ -0,0 +1,9 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context process-timers generated nominal declarations; do not edit.+module Generated.ProcessTimers.Nominals+  ( IncidentId+  , parseIncidentId+  , mkIncidentId+  , incidentIdText+  ) where++import Generated.ProcessTimers.Nominals.Internal (IncidentId, mkIncidentId, parseIncidentId, incidentIdText)
+ test/conformance-process-timers/Generated/ProcessTimers/Nominals/Internal.hs view
@@ -0,0 +1,40 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context process-timers generated nominal ID internals; do not edit.+module Generated.ProcessTimers.Nominals.Internal+  ( IncidentId+  , parseIncidentId+  , mkIncidentId+  , incidentIdText+  , unsafeIncidentIdFromLegacyText+  ) 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)++newtype IncidentId = IncidentId Text+  deriving stock (Generic, Eq, Ord, Show)++instance CanonicalTypeName IncidentId++instance ToJSON IncidentId where+  toJSON = toJSON . incidentIdText++instance FromJSON IncidentId where+  parseJSON = withText "IncidentId" (either (fail . T.unpack) pure . parseIncidentId)++parseIncidentId :: Text -> Either Text IncidentId+parseIncidentId input = case validateIdDomainText (typeIdV7Domain "inc") input of+  Left reason -> Left (T.pack (show reason))+  Right () -> Right (IncidentId input)++mkIncidentId :: Text -> Either Text IncidentId+mkIncidentId = parseIncidentId++incidentIdText :: IncidentId -> Text+incidentIdText (IncidentId value) = value++unsafeIncidentIdFromLegacyText :: Text -> IncidentId+unsafeIncidentIdFromLegacyText = IncidentId
+ test/conformance-process-timers/Generated/ProcessTimers/ReplayAudit.hs view
@@ -0,0 +1,30 @@+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from context process-timers replay-audit assembly; do not edit.+--+-- 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 Generated.ProcessTimers.ReplayAudit (auditTargets) where++import Generated.ProcessTimers.IncidentSaga.EventStream qualified as IncidentSaga+import Generated.ProcessTimers.Incident.EventStream qualified as Incident+import Keiro.ReplayAudit (AuditTarget (..), SomeAuditTarget (..), streamInCategory)+import Keiro.Stream qualified as Stream++auditTargets :: [SomeAuditTarget]+auditTargets =+  [ SomeAuditTarget+      AuditTarget+        { eventStream = IncidentSaga.incidentSagaEventStream+        , category = Stream.categoryText IncidentSaga.incidentSagaCategory+        , mkStream = streamInCategory (Stream.categoryText IncidentSaga.incidentSagaCategory)+        }+  , SomeAuditTarget+      AuditTarget+        { eventStream = Incident.incidentEventStream+        , category = Stream.categoryText Incident.incidentCategory+        , mkStream = streamInCategory (Stream.categoryText Incident.incidentCategory)+        }+  ]
+ test/conformance-process-timers/Main.hs view
@@ -0,0 +1,250 @@+module Main (main) where++import Control.Monad (forM_, unless)+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as BS+import Data.Text qualified as T+import Data.Text.Encoding (encodeUtf8)+import Data.Time (UTCTime (..), addUTCTime, getCurrentTime, secondsToDiffTime)+import Data.Time.Calendar (Day (ModifiedJulianDay))+import Data.UUID qualified as UUID+import Data.UUID.V5 qualified as UUID.V5+import Data.Vector qualified as Vector+import Generated.ProcessTimers.Incident.Codec (incidentCodec)+import Generated.ProcessTimers.Incident.Domain (IncidentEscalatedData (..), IncidentEvent (..))+import Generated.ProcessTimers.IncidentTimers.Process+import Generated.ProcessTimers.Nominals (mkIncidentId)+import Keiro.Codec (decodeRecorded)+import Keiro.Command (defaultRunCommandOptions)+import Keiro.DeterministicId (identitySeedBytes)+import Keiro.ProcessManager.Reaction qualified as Reaction+import Keiro.Test.Postgres (Fixture, StoreRunner (..), withFreshResourceStore, withMigratedSuite)+import Keiro.Timer (TimerId (..), TimerRequest (..), TimerRow (..), TimerStatus (..), claimDueTimer, lookupTimer, markTimerFired, runTimerWorkerWith)+import Kiroku.Store qualified as Store+import Kiroku.Store.Types (EventId (..), EventType (..), GlobalPosition (..), RecordedEvent (..), StreamId (..), StreamName (..), StreamVersion (..))++main :: IO ()+main =+  withMigratedSuite $ \fixture -> do+    identityVectorCase+    withFreshResourceStore fixture $ \(_storeHandle, StoreRunner runStore) -> do+      incidentId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn02q")+      let firstInput = IncidentReported incidentId firstObserved "first"+          secondInput = IncidentReported incidentId secondObserved "second"+          firstEvent = recorded sourceUuid1 1 firstInput+          secondEvent = recorded sourceUuid2 2 secondInput+          escalationAt observed = addUTCTime 300 observed+          reminderAt observed = addUTCTime 3600 observed+          firstEscalation = incidentTimersEscalationTimerRequest "inc_01h455vb4pex5vsknk084sn02q" (escalationAt firstObserved) incidentId "first"+          firstReminder = incidentTimersReminderTimerRequest "inc_01h455vb4pex5vsknk084sn02q" (reminderAt firstObserved) incidentId++      first <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager firstEvent firstInput)+      firstResult <- expectRight first+      assert "first delivery committed both timer statements" (firstResult.timerEffects == Reaction.ReactionTimerEffects 2 1 0)++      escalation1 <- requireTimer =<< (expectRight =<< runStore (lookupTimer firstEscalation.timerId))+      reminder1 <- requireTimer =<< (expectRight =<< runStore (lookupTimer firstReminder.timerId))+      assert "rearm timer used the first deadline" (escalation1.fireAt == escalationAt firstObserved)+      assert "once timer used the first deadline" (reminder1.fireAt == reminderAt firstObserved)+      assert "dynamic payload round-trips" $ case Aeson.fromJSON escalation1.payload of+        Aeson.Success EscalationPayload {detail = "first"} -> True+        _ -> False+      assert "timer identity prefix is pinned" (firstEscalation.timerId == expectedEscalationTimerId)++      second <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager secondEvent secondInput)+      secondResult <- expectRight second+      assert "second accepted source attempted both schedules" (secondResult.timerEffects == Reaction.ReactionTimerEffects 2 0 0)+      escalation2 <- requireTimer =<< (expectRight =<< runStore (lookupTimer firstEscalation.timerId))+      reminder2 <- requireTimer =<< (expectRight =<< runStore (lookupTimer firstReminder.timerId))+      assert "rearm moved the still-scheduled deadline" (escalation2.fireAt == escalationAt secondObserved)+      assert "once preserved the original deadline" (reminder2.fireAt == reminderAt firstObserved)++      replay <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager secondEvent secondInput)+      replayResult <- expectRight replay+      assert "accepted replay skipped timer SQL" (replayResult.timerEffects == Reaction.ReactionTimerEffects 0 0 0)++      cancelled <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager (recorded sourceUuid3 3 (ResponderAcked incidentId)) (ResponderAcked incidentId))+      cancelledResult <- expectRight cancelled+      assert "cancel reports its committed and changed counts" (cancelledResult.timerEffects == Reaction.ReactionTimerEffects 1 0 1)+      reminderCancelled <- requireTimer =<< (expectRight =<< runStore (lookupTimer firstReminder.timerId))+      assert "cancelled timer is terminal" (reminderCancelled.status == Cancelled)++      claimedEscalation <- requireTimer =<< (expectRight =<< runStore (claimDueTimer (addUTCTime 1 escalation2.fireAt)))+      assert "due escalation is claimed before firing" (claimedEscalation.status == Firing)+      fired <- expectRight =<< runStore (incidentTimersFireTimer defaultRunCommandOptions claimedEscalation)+      assert "generated firer returns its deterministic event id" (fired /= Nothing)+      redelivered <- expectRight =<< runStore (incidentTimersFireTimer defaultRunCommandOptions claimedEscalation)+      assert "timer fire redelivery confirms the target witness" (redelivered == fired)+      firedId <- maybe (fail "expected escalation fired event id") pure fired+      marked <- expectRight =<< runStore (markTimerFired firstEscalation.timerId firedId)+      assert "claimed escalation reaches terminal fired state" marked++      let thirdInput = IncidentReported incidentId (addUTCTime 600 secondObserved) "third"+      third <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager (recorded sourceUuid4 4 thirdInput) thirdInput)+      thirdResult <- expectRight third+      assert "terminal reschedule attempts still commit both statements" (thirdResult.timerEffects == Reaction.ReactionTimerEffects 2 0 0)+      escalationTerminal <- requireTimer =<< (expectRight =<< runStore (lookupTimer firstEscalation.timerId))+      reminderTerminal <- requireTimer =<< (expectRight =<< runStore (lookupTimer firstReminder.timerId))+      assert "rearm does not revive a fired timer" (escalationTerminal.status == Fired && escalationTerminal.fireAt == escalation2.fireAt)+      assert "schedule once does not revive a cancelled timer" (reminderTerminal.status == Cancelled && reminderTerminal.fireAt == reminder1.fireAt)++      targetEvents <- expectRight =<< runStore (Store.readStreamForward (StreamName "incident-inc_01h455vb4pex5vsknk084sn02q") (StreamVersion 0) 10)+      assert "timer firing appends once" (Vector.length targetEvents == 1)+      assert "escalation timer fires the declared command" $+        traverse (decodeRecorded incidentCodec) (Vector.toList targetEvents)+          == Right [IncidentEscalated (IncidentEscalatedData incidentId)]+    absentCancelCase fixture+    claimedCancelRaceCase fixture+    ceilingCase fixture+    putStrLn "process timer conformance: PASS"++identityVectorCase :: IO ()+identityVectorCase = do+  UUID.toText (reactionIdentity "incident-escalation-timer:" "inc_01h455vb4pex5vsknk084sn02q")+    `assertEqual` "58406c5e-b75e-515c-8a0c-30a4266b4b89"+  UUID.toText (reactionIdentity "incident-escalation-timer:" "\x0101")+    `assertEqual` "be5128ce-0df9-52a8-b2c8-5bd54ced1280"+  UUID.toText (reactionIdentity "incident-escalation-timer:" "\SOH")+    `assertEqual` "77aba1e9-500c-5e71-ae70-5194c47e5a30"+  oldIdentity "\x0101" `assertEqual` oldIdentity "\SOH"+  reactionIdentity "incident-escalation-timer:" "\x0101"+    `assertNotEqual` reactionIdentity "incident-escalation-timer:" "\SOH"+  where+    oldIdentity correlation =+      UUID.V5.generateNamed+        UUID.V5.namespaceURL+        (map (fromIntegral . fromEnum) ("incident-escalation-timer:" <> correlation))++reactionIdentity :: T.Text -> T.Text -> UUID.UUID+reactionIdentity prefix correlation =+  UUID.V5.generateNamed UUID.V5.namespaceURL (identitySeedBytes (T.concat (map field [prefix, correlation])))+  where+    field value = T.pack (show (BS.length (encodeUtf8 value))) <> ":" <> value++assertEqual :: (Eq a, Show a) => a -> a -> IO ()+assertEqual actual expected = unless (actual == expected) (error ("expected " <> show expected <> ", got " <> show actual))++assertNotEqual :: (Eq a, Show a) => a -> a -> IO ()+assertNotEqual left right = unless (left /= right) (error ("expected distinct values, got " <> show left))++absentCancelCase :: Fixture -> IO ()+absentCancelCase fixture =+  withFreshResourceStore fixture $ \(_storeHandle, StoreRunner runStore) -> do+    incidentId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn04s")+    let request = incidentTimersReminderTimerRequest "inc_01h455vb4pex5vsknk084sn04s" (addUTCTime 3600 firstObserved) incidentId+        acknowledged = ResponderAcked incidentId+    cancelled <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager (recorded sourceUuid5 5 acknowledged) acknowledged)+    cancelledResult <- expectRight cancelled+    assert "absent cancel commits a statement without changing a row" (cancelledResult.timerEffects == Reaction.ReactionTimerEffects 1 0 0)+    absent <- expectRight =<< runStore (lookupTimer request.timerId)+    assert "absent cancel creates no tombstone" (absent == Nothing)+    let reported = IncidentReported incidentId firstObserved "after-absent-cancel"+    scheduled <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager (recorded sourceUuid6 6 reported) reported)+    scheduledResult <- expectRight scheduled+    assert "once schedule inserts after absent cancel" (scheduledResult.timerEffects == Reaction.ReactionTimerEffects 2 1 0)+    _ <- requireTimer =<< (expectRight =<< runStore (lookupTimer request.timerId))+    pure ()++claimedCancelRaceCase :: Fixture -> IO ()+claimedCancelRaceCase fixture =+  withFreshResourceStore fixture $ \(_storeHandle, StoreRunner runStore) -> do+    incidentId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn05t")+    let key = "inc_01h455vb4pex5vsknk084sn05t"+        reported = IncidentReported incidentId firstObserved "claim-race"+        escalation = incidentTimersEscalationTimerRequest key (addUTCTime 300 firstObserved) incidentId "claim-race"+        reminder = incidentTimersReminderTimerRequest key (addUTCTime 3600 firstObserved) incidentId+    scheduled <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager (recorded sourceUuid7 7 reported) reported)+    _ <- expectRight scheduled+    claimedEscalation <- requireTimer =<< (expectRight =<< runStore (claimDueTimer (addUTCTime 400 firstObserved)))+    escalationEvent <- requireEventId =<< (expectRight =<< runStore (incidentTimersFireTimer defaultRunCommandOptions claimedEscalation))+    escalationMarked <- expectRight =<< runStore (markTimerFired escalation.timerId escalationEvent)+    assert "race setup marks escalation fired" escalationMarked+    claimedReminder <- requireTimer =<< (expectRight =<< runStore (claimDueTimer (addUTCTime 4000 firstObserved)))+    assert "reminder is already claimed before cancellation" (claimedReminder.timerId == reminder.timerId && claimedReminder.status == Firing)+    let acknowledged = ResponderAcked incidentId+    cancelled <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager (recorded sourceUuid8 8 acknowledged) acknowledged)+    cancelledResult <- expectRight cancelled+    assert "cancel can race an already claimed timer" (cancelledResult.timerEffects == Reaction.ReactionTimerEffects 1 0 1)+    reminderEvent <- requireEventId =<< (expectRight =<< runStore (incidentTimersFireTimer defaultRunCommandOptions claimedReminder))+    reminderMarked <- expectRight =<< runStore (markTimerFired reminder.timerId reminderEvent)+    assert "cancelled row remains terminal after the claimed fire attempt" (not reminderMarked)+    reminderTerminal <- requireTimer =<< (expectRight =<< runStore (lookupTimer reminder.timerId))+    assert "claimed cancel race leaves the timer cancelled" (reminderTerminal.status == Cancelled)+    targetEvents <- expectRight =<< runStore (Store.readStreamForward (StreamName ("incident-" <> key)) (StreamVersion 0) 10)+    assert "claimed cancel race is harmless under the target state guard" (Vector.length targetEvents == 1)++ceilingCase :: Fixture -> IO ()+ceilingCase fixture =+  withFreshResourceStore fixture $ \(_storeHandle, StoreRunner runStore) -> do+    incidentId <- either (fail . show) pure (mkIncidentId "inc_01h455vb4pex5vsknk084sn06v")+    let key = "inc_01h455vb4pex5vsknk084sn06v"+        reported = IncidentReported incidentId firstObserved "ceiling"+        escalation = incidentTimersEscalationTimerRequest key (addUTCTime 300 firstObserved) incidentId "ceiling"+    scheduled <- expectRight =<< runStore (Reaction.runReactiveProcessManagerOnce defaultRunCommandOptions incidentTimersProcessManager (recorded sourceUuid9 9 reported) reported)+    _ <- expectRight scheduled+    now <- getCurrentTime+    forM_ [0 .. 5 :: Int] $ \attempt -> do+      _ <- expectRight =<< runStore (runTimerWorkerWith Nothing incidentTimersTimerWorkerOptions (addUTCTime (fromIntegral (attempt * 400)) now) (\_ -> pure Nothing))+      pure ()+    terminal <- requireTimer =<< (expectRight =<< runStore (lookupTimer escalation.timerId))+    assert "generated attempt ceiling dead-letters before a sixth fire" (terminal.status == Dead && terminal.attempts == 6)++recorded :: UUID.UUID -> Int -> IncidentTimersInput -> RecordedEvent+recorded eventUuid position input =+  RecordedEvent+    { eventId = EventId eventUuid,+      eventType = EventType "ProcessTimerInput",+      streamVersion = StreamVersion (fromIntegral position),+      globalPosition = GlobalPosition (fromIntegral position),+      originalStreamId = StreamId 1,+      originalVersion = StreamVersion (fromIntegral position),+      payload = Aeson.toJSON input,+      metadata = Nothing,+      causationId = Nothing,+      correlationId = Nothing,+      createdAt = firstObserved+    }++firstObserved :: UTCTime+firstObserved = UTCTime (ModifiedJulianDay 60000) (secondsToDiffTime 0)++secondObserved :: UTCTime+secondObserved = addUTCTime 600 firstObserved++expectedEscalationTimerId :: TimerId+expectedEscalationTimerId =+  TimerId+    ( UUID.V5.generateNamed+        UUID.V5.namespaceURL+        (identitySeedBytes (T.concat (map field ["incident-escalation-timer:", "inc_01h455vb4pex5vsknk084sn02q"])))+    )+  where+    field value = T.pack (show (BS.length (encodeUtf8 value))) <> ":" <> value++sourceUuid1, sourceUuid2, sourceUuid3, sourceUuid4, sourceUuid5, sourceUuid6, sourceUuid7, sourceUuid8, sourceUuid9 :: UUID.UUID+sourceUuid1 = staticUuid "123e4567-e89b-72d3-a456-426614174001"+sourceUuid2 = staticUuid "123e4567-e89b-72d3-a456-426614174002"+sourceUuid3 = staticUuid "123e4567-e89b-72d3-a456-426614174003"+sourceUuid4 = staticUuid "123e4567-e89b-72d3-a456-426614174004"+sourceUuid5 = staticUuid "123e4567-e89b-72d3-a456-426614174005"+sourceUuid6 = staticUuid "123e4567-e89b-72d3-a456-426614174006"+sourceUuid7 = staticUuid "123e4567-e89b-72d3-a456-426614174007"+sourceUuid8 = staticUuid "123e4567-e89b-72d3-a456-426614174008"+sourceUuid9 = staticUuid "123e4567-e89b-72d3-a456-426614174009"++staticUuid :: String -> UUID.UUID+staticUuid value = case UUID.fromString value of+  Just uuid -> uuid+  Nothing -> error "invalid static UUID"++requireTimer :: Maybe TimerRow -> IO TimerRow+requireTimer = maybe (fail "expected timer row") pure++requireEventId :: Maybe EventId -> IO EventId+requireEventId = maybe (fail "expected fired event id") pure++expectRight :: Show problem => Either problem value -> IO value+expectRight = either (error . show) pure++assert :: String -> Bool -> IO ()+assert label condition = unless condition (error ("process timer conformance failed: " <> label))
+ test/conformance-process-timers/ProcessTimers/Incident/BehaviorHoles.hs view
@@ -0,0 +1,12 @@+-- Consumer-owned behavioral witnesses. Created once; never overwritten.+module ProcessTimers.Incident.BehaviorHoles (behaviorWitnesses) where++import Generated.ProcessTimers.Incident.BehaviorContract++behaviorWitnesses :: [BehaviorWitness]+behaviorWitnesses =+  [ Pending (BehaviorKey "behavior-v1-93455a87d5151176") -- IncidentOpen x RemindIncident: live transition+  , Pending (BehaviorKey "behavior-v1-b944c85b616b9349") -- IncidentOpen x EscalateIncident: live transition+  , Pending (BehaviorKey "behavior-v1-48ce258ccf64ef4e") -- IncidentEscalatedState x EscalateIncident: required rejection+  , Pending (BehaviorKey "behavior-v1-d66d007f74139a07") -- IncidentEscalatedState x RemindIncident: required rejection+  ]
+ test/conformance-process-timers/ProcessTimers/IncidentSaga/BehaviorHoles.hs view
@@ -0,0 +1,9 @@+-- Consumer-owned behavioral witnesses. Created once; never overwritten.+module ProcessTimers.IncidentSaga.BehaviorHoles (behaviorWitnesses) where++import Generated.ProcessTimers.IncidentSaga.BehaviorContract++behaviorWitnesses :: [BehaviorWitness]+behaviorWitnesses =+  [ Pending (BehaviorKey "behavior-v1-af16dd42cbccd576") -- IncidentSagaOpen x RecordIncident: live transition+  ]
+ test/conformance-process-timers/ProcessTimers/IncidentTimers/ProcessHoles.hs view
@@ -0,0 +1,11 @@+-- keiro-dsl process-hole contract v1+-- HAND-OWNED typed decoder; created once and never overwritten.+module ProcessTimers.IncidentTimers.ProcessHoles (decodeIncidentTimersInput) where++import Data.Aeson (parseJSON)+import Data.Aeson.Types (parseMaybe)+import Generated.ProcessTimers.IncidentTimers.Input (IncidentTimersInput)+import Kiroku.Store.Types (RecordedEvent (..))++decodeIncidentTimersInput :: RecordedEvent -> Maybe IncidentTimersInput+decodeIncidentTimersInput event = parseMaybe parseJSON event.payload
+ test/conformance-process-timers/keiro-dsl-cabal-fragment.context.process-timers.txt view
@@ -0,0 +1,47 @@+-- keiro-dsl build manifest for keiro-dsl/test/fixtures/process-timers.keiro+-- Paste the complete fragment below into the consuming Cabal stanza.+-- The generated layer is overwritten on every scaffold; hole modules are+-- create-if-absent (filled by hand).++default-language: GHC2024+default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings++other-modules:+    Generated.ProcessTimers.BehaviorSourceMap+    Generated.ProcessTimers.Incident.BehaviorContract+    Generated.ProcessTimers.Incident.Codec+    Generated.ProcessTimers.Incident.Domain+    Generated.ProcessTimers.Incident.EventStream+    Generated.ProcessTimers.Incident.Harness+    Generated.ProcessTimers.Incident.Projection+    Generated.ProcessTimers.Incident.Transducer+    Generated.ProcessTimers.IncidentSaga.BehaviorContract+    Generated.ProcessTimers.IncidentSaga.Codec+    Generated.ProcessTimers.IncidentSaga.Domain+    Generated.ProcessTimers.IncidentSaga.EventStream+    Generated.ProcessTimers.IncidentSaga.Harness+    Generated.ProcessTimers.IncidentSaga.Projection+    Generated.ProcessTimers.IncidentSaga.Transducer+    Generated.ProcessTimers.IncidentTimers.Input+    Generated.ProcessTimers.IncidentTimers.Process+    Generated.ProcessTimers.IncidentTimers.ProcessHarness+    Generated.ProcessTimers.Nominals+    Generated.ProcessTimers.Nominals.Internal+    Generated.ProcessTimers.ReplayAudit+    ProcessTimers.Incident.BehaviorHoles+    ProcessTimers.IncidentSaga.BehaviorHoles+    ProcessTimers.IncidentTimers.ProcessHoles++build-depends:+    , aeson+    , base+    , keiki+    , keiro+    , shibuya-core+    , text+    , time+    , uuid
+ test/conformance-process-timers/keiro-dsl-ledger.context.process-timers.txt view
@@ -0,0 +1,64 @@+keiro-dsl scaffold record v1+spec: keiro-dsl/test/fixtures/process-timers.keiro+module-root: (none)+layout: prefixed+source-language {"declaredLanguageVersion":6,"effectiveLanguageVersion":6,"sourceForm":"declared"}+semantic-contract {"languageSupport":"candidate","languageVersion":6,"runtimeSemantics":"keiro-dsl/runtime-semantics/5"}+naming-edition idiomatic-v2+module-role {"family":"BehaviorSourceMap","kind":"generated","ownerKind":"context","ownerName":"context process-timers behavior source map","path":"Generated/ProcessTimers/BehaviorSourceMap.hs"}+module-role {"family":"Nominals","kind":"generated","ownerKind":"context","ownerName":"context process-timers generated nominal declarations","path":"Generated/ProcessTimers/Nominals.hs"}+module-role {"family":"Internal","kind":"generated","ownerKind":"context","ownerName":"context process-timers generated nominal ID internals","path":"Generated/ProcessTimers/Nominals/Internal.hs"}+module-role {"family":"ReplayAudit","kind":"generated","ownerKind":"context","ownerName":"context process-timers replay-audit assembly","path":"Generated/ProcessTimers/ReplayAudit.hs"}+module-role {"family":"Input","kind":"generated","ownerKind":"process","ownerName":"process input IncidentTimers (line 6)","path":"Generated/ProcessTimers/IncidentTimers/Input.hs"}+module-role {"family":"Process","kind":"generated","ownerKind":"process","ownerName":"process reaction IncidentTimers (line 6)","path":"Generated/ProcessTimers/IncidentTimers/Process.hs"}+module-role {"family":"ProcessHoles","kind":"hole","ownerKind":"process","ownerName":"process decoder IncidentTimers (line 6)","path":"ProcessTimers/IncidentTimers/ProcessHoles.hs"}+module-role {"family":"ProcessHarness","kind":"generated","ownerKind":"process","ownerName":"process IncidentTimers (line 6)","path":"Generated/ProcessTimers/IncidentTimers/ProcessHarness.hs"}+module-role {"family":"Domain","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 46)","path":"Generated/ProcessTimers/IncidentSaga/Domain.hs"}+module-role {"family":"Codec","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 46)","path":"Generated/ProcessTimers/IncidentSaga/Codec.hs"}+module-role {"family":"Transducer","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 46)","path":"Generated/ProcessTimers/IncidentSaga/Transducer.hs"}+module-role {"family":"BehaviorContract","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 46)","path":"Generated/ProcessTimers/IncidentSaga/BehaviorContract.hs"}+module-role {"family":"BehaviorHoles","kind":"hole","ownerKind":"aggregate","ownerName":"aggregate behavior witnesses IncidentSaga (line 46)","path":"ProcessTimers/IncidentSaga/BehaviorHoles.hs"}+module-role {"family":"EventStream","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 46)","path":"Generated/ProcessTimers/IncidentSaga/EventStream.hs"}+module-role {"family":"Projection","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 46)","path":"Generated/ProcessTimers/IncidentSaga/Projection.hs"}+module-role {"family":"Harness","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate IncidentSaga (line 46)","path":"Generated/ProcessTimers/IncidentSaga/Harness.hs"}+module-role {"family":"Domain","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 53)","path":"Generated/ProcessTimers/Incident/Domain.hs"}+module-role {"family":"Codec","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 53)","path":"Generated/ProcessTimers/Incident/Codec.hs"}+module-role {"family":"Transducer","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 53)","path":"Generated/ProcessTimers/Incident/Transducer.hs"}+module-role {"family":"BehaviorContract","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 53)","path":"Generated/ProcessTimers/Incident/BehaviorContract.hs"}+module-role {"family":"BehaviorHoles","kind":"hole","ownerKind":"aggregate","ownerName":"aggregate behavior witnesses Incident (line 53)","path":"ProcessTimers/Incident/BehaviorHoles.hs"}+module-role {"family":"EventStream","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 53)","path":"Generated/ProcessTimers/Incident/EventStream.hs"}+module-role {"family":"Projection","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 53)","path":"Generated/ProcessTimers/Incident/Projection.hs"}+module-role {"family":"Harness","kind":"generated","ownerKind":"aggregate","ownerName":"aggregate Incident (line 53)","path":"Generated/ProcessTimers/Incident/Harness.hs"}+generated Generated/ProcessTimers/BehaviorSourceMap.hs+generated Generated/ProcessTimers/Nominals.hs+generated Generated/ProcessTimers/Nominals/Internal.hs+generated Generated/ProcessTimers/ReplayAudit.hs+generated Generated/ProcessTimers/IncidentTimers/Input.hs+generated Generated/ProcessTimers/IncidentTimers/Process.hs+hole ProcessTimers/IncidentTimers/ProcessHoles.hs+generated Generated/ProcessTimers/IncidentTimers/ProcessHarness.hs+generated Generated/ProcessTimers/IncidentSaga/Domain.hs+generated Generated/ProcessTimers/IncidentSaga/Codec.hs+generated Generated/ProcessTimers/IncidentSaga/Transducer.hs+generated Generated/ProcessTimers/IncidentSaga/BehaviorContract.hs+hole ProcessTimers/IncidentSaga/BehaviorHoles.hs+generated Generated/ProcessTimers/IncidentSaga/EventStream.hs+generated Generated/ProcessTimers/IncidentSaga/Projection.hs+generated Generated/ProcessTimers/IncidentSaga/Harness.hs+generated Generated/ProcessTimers/Incident/Domain.hs+generated Generated/ProcessTimers/Incident/Codec.hs+generated Generated/ProcessTimers/Incident/Transducer.hs+generated Generated/ProcessTimers/Incident/BehaviorContract.hs+hole ProcessTimers/Incident/BehaviorHoles.hs+generated Generated/ProcessTimers/Incident/EventStream.hs+generated Generated/ProcessTimers/Incident/Projection.hs+generated Generated/ProcessTimers/Incident/Harness.hs+id-domain id-domain|name=IncidentId|contract=keiro-dsl/id-domain/typeid-v7/1|prefix=inc|separator=_|json=canonical-json-text+nominal-equality nominal-equality|name=IncidentId|contract=keiro-dsl/nominal-equality/2|key=Text|domain=typeid-v7-text:inc:keiro-dsl/id-domain/typeid-v7/1|owner=generated+behavior {"aggregate":"Incident","command":"EscalateIncident","evidence":"generated-authoritative","key":"behavior-v1-48ce258ccf64ef4e","kind":"required-rejection","outputs":[],"source":"EscalatedState"}+behavior {"aggregate":"Incident","command":"RemindIncident","evidence":"generated-authoritative","key":"behavior-v1-93455a87d5151176","kind":"live-transition","outputs":[{"command":"RemindIncident","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"IncidentSaga","command":"RecordIncident","evidence":"generated-authoritative","key":"behavior-v1-af16dd42cbccd576","kind":"live-transition","outputs":[{"command":"RecordIncident","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"Incident","command":"EscalateIncident","evidence":"generated-authoritative","key":"behavior-v1-b944c85b616b9349","kind":"live-transition","outputs":[{"command":"EscalateIncident","ownership":"generated-command-identity"}],"source":"Open"}+behavior {"aggregate":"Incident","command":"RemindIncident","evidence":"generated-authoritative","key":"behavior-v1-d66d007f74139a07","kind":"required-rejection","outputs":[],"source":"EscalatedState"}+process-reaction {"fingerprint":"5a6afd7c9691c5716a9c7b3140b5c6c54ff8689aa6e0fbc9acf576ce56aa4904","holeObligations":["decodeIncidentTimersInput :: RecordedEvent -> Maybe IncidentTimersInput"],"processName":"incident-timers","verification":"generated-declarative","version":1}+semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
test/conformance-process/Generated/HospitalCapacity/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context hospital-capacity behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context hospital-capacity behavior source map; do not edit. module Generated.HospitalCapacity.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-process/Generated/HospitalCapacity/Hospital/BehaviorContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-process/Generated/HospitalCapacity/Hospital/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Codec (     hospitalCodec,     parseHospitalEvent,
test/conformance-process/Generated/HospitalCapacity/Hospital/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Domain where  import GHC.Generics (Generic)
test/conformance-process/Generated/HospitalCapacity/Hospital/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.EventStream   ( hospitalCategory   , hospitalCommandCategory
test/conformance-process/Generated/HospitalCapacity/Hospital/Harness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Harness (harnessAssertions) where  import Generated.HospitalCapacity.Hospital.Domain
test/conformance-process/Generated/HospitalCapacity/Hospital/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-process/Generated/HospitalCapacity/Hospital/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit. module Generated.HospitalCapacity.Hospital.Transducer   ( hospitalTransducer   , hospitalFoldFingerprint
test/conformance-process/Generated/HospitalCapacity/HospitalSurge/Process.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from process HospitalSurge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from process HospitalSurge; do not edit. module Generated.HospitalCapacity.HospitalSurge.Process   ( hospitalSurgeProcessName   , hospitalSurgeCategory
test/conformance-process/Generated/HospitalCapacity/HospitalSurge/ProcessHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from process HospitalSurge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from process HospitalSurge; do not edit. module Generated.HospitalCapacity.HospitalSurge.ProcessHarness (processHarnessValues) where  -- | (label, value): the spec's deterministic process/timer decisions,
test/conformance-process/Generated/HospitalCapacity/Nominals.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal declarations; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal declarations; do not edit. module Generated.HospitalCapacity.Nominals   ( CommandId   , parseCommandId
test/conformance-process/Generated/HospitalCapacity/Nominals/Internal.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal ID internals; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal ID internals; do not edit. module Generated.HospitalCapacity.Nominals.Internal   ( CommandId   , parseCommandId
test/conformance-process/Generated/HospitalCapacity/ReplayAudit.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from context hospital-capacity replay-audit assembly; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from context hospital-capacity replay-audit assembly; do not edit. -- -- Deployment contract: --   * replay-neutral diff: no data audit is required;
test/conformance-process/Generated/HospitalCapacity/Surge/BehaviorContract.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.BehaviorContract   ( BehaviorKey (..)   , unBehaviorKey
test/conformance-process/Generated/HospitalCapacity/Surge/Codec.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Codec (     surgeCodec,     parseSurgeEvent,
test/conformance-process/Generated/HospitalCapacity/Surge/Domain.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Domain where  import Data.Text (Text)
test/conformance-process/Generated/HospitalCapacity/Surge/EventStream.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.EventStream   ( surgeCategory   , surgeCommandCategory
test/conformance-process/Generated/HospitalCapacity/Surge/Harness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Harness (harnessAssertions) where  import Generated.HospitalCapacity.Surge.Domain
test/conformance-process/Generated/HospitalCapacity/Surge/Projection.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Projection () where  -- No projection declarations are present; this module keeps the generated manifest inventory total.
test/conformance-process/Generated/HospitalCapacity/Surge/Transducer.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE QualifiedDo #-}--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit. module Generated.HospitalCapacity.Surge.Transducer   ( surgeTransducer   , surgeFoldFingerprint
test/conformance-process/keiro-dsl-ledger.context.hospital-capacity.txt view
@@ -58,4 +58,5 @@ behavior {"aggregate":"Surge","command":"NoteSurgeThreshold","evidence":"generated-authoritative","key":"behavior-v1-5198a253324042e6","kind":"live-transition","outputs":[{"command":"NoteSurgeThreshold","ownership":"generated-command-identity"}],"source":"Idle"} behavior {"aggregate":"Surge","command":"MarkSurgeTimerFired","evidence":"generated-authoritative","key":"behavior-v1-6721e0b61aa38780","kind":"live-transition","outputs":[{"command":"MarkSurgeTimerFired","ownership":"generated-command-identity"}],"source":"Idle"} behavior {"aggregate":"Hospital","command":"ActivateSurge","evidence":"generated-authoritative","key":"behavior-v1-69ac3daa8569d350","kind":"live-transition","outputs":[{"command":"ActivateSurge","ownership":"generated-command-identity"}],"source":"Operational"}+process-reaction {"fingerprint":null,"holeObligations":[],"processName":"hospital-surge","verification":"custom-unverified","version":null} semantic-impact {"declarations":[],"mappedSurfaceEvidenceVersion":1,"serviceInventory":[]}
test/conformance-projection-catalog/Generated/CatalogDemo/BehaviorSourceMap.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from context catalog-demo behavior source map; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from context catalog-demo behavior source map; do not edit. module Generated.CatalogDemo.BehaviorSourceMap   ( BehaviorSourceLocation (..)   , behaviorSourceLocation
test/conformance-projection-catalog/Generated/CatalogDemo/CatalogAudit/ReadModel.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel catalogAudit; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel catalogAudit; do not edit. module Generated.CatalogDemo.CatalogAudit.ReadModel   ( catalogAuditReadModel   , catalogAuditQualifiedTable
test/conformance-projection-catalog/Generated/CatalogDemo/CatalogAudit/ReadModelHarness.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel catalogAudit; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel catalogAudit; do not edit. module Generated.CatalogDemo.CatalogAudit.ReadModelHarness (readModelFacts, readModelFactResults, runReadModelFacts, catalogFactsAgainst) where  import Generated.CatalogDemo.CatalogAudit.ReadModel (catalogAuditReadModel)
test/conformance-projection-catalog/Generated/CatalogDemo/CatalogAudit/ReadModelTable.hs view
@@ -1,4 +1,4 @@--- @generated by keiro-dsl 0.16.0.0 (language keiro-dsl 5) from readmodel catalogAudit; do not edit.+-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 5) from readmodel catalogAudit; do not edit. module Generated.CatalogDemo.CatalogAudit.ReadModelTable (catalogAuditQualifiedTable) where  import Data.Text (Text)
test/conformance-projection-catalog/Generated/CatalogDemo/OrderInline/QueryContract.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/OrderInline/ReadModel.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/OrderInline/ReadModelHarness.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/OrderInline/ReadModelTable.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/OrderTotalsLookup/ReadModel.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/OrderTotalsLookup/ReadModelHarness.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/OrderTotalsLookup/ReadModelTable.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Orders/BehaviorContract.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Codec.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Domain.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Orders/EventStream.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Harness.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Projection.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Transducer.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/ProjectionCatalog.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/QualificationJobs/Queue.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/QualificationJobs/QueueCodec.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/QualificationJobs/QueuePolicy.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/ReplayAudit.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/ShipmentLookup/ReadModel.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/ShipmentLookup/ReadModelHarness.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/ShipmentLookup/ReadModelTable.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/BehaviorContract.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Codec.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Domain.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/EventStream.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Harness.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Projection.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Transducer.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/Structural/Shape/QualificationPayload.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/StructuralConformance.hs view

file too large to diff

test/conformance-projection-catalog/Generated/CatalogDemo/StructuralProjections.hs view

file too large to diff

test/conformance-publisher-runtime/Generated/HospitalCapacity/Emergency/Contract.hs view

file too large to diff

test/conformance-publisher-runtime/Generated/HospitalCapacity/HospitalPublisher/Publisher.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModel.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelHarness.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelTable.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/ReservationWork/Queue.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/ReservationWork/QueueCodec.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/ReservationWork/QueuePolicy.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModel.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModelHarness.hs view

file too large to diff

test/conformance-queue-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModelTable.hs view

file too large to diff

test/conformance-queue-runtime/Main.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModel.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelHarness.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelTable.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/ReservationWork/Queue.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/ReservationWork/QueueCodec.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/ReservationWork/QueuePolicy.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/TransferDecisions/ReadModel.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/TransferDecisions/ReadModelHarness.hs view

file too large to diff

test/conformance-queue/Generated/HospitalCapacity/TransferDecisions/ReadModelTable.hs view

file too large to diff

test/conformance-readmodel-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModel.hs view

file too large to diff

test/conformance-readmodel-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModelHarness.hs view

file too large to diff

test/conformance-readmodel-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModelTable.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/BehaviorSourceMap.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/Note/BehaviorContract.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/Note/Codec.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/Note/Domain.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/Note/EventStream.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/Note/Harness.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/Note/Projection.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/Note/Transducer.hs view

file too large to diff

test/conformance-replay/Generated/ReplayDivergence/ReplayAudit.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/BehaviorSourceMap.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/Page/BehaviorContract.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/Page/Codec.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/Page/Domain.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/Page/EventStream.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/Page/Harness.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/Page/Projection.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/Page/Transducer.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/PagingRouter/Router.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/PagingRouter/RouterHarness.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/ReplayAudit.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/ServiceOncall/ReadModel.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/ServiceOncall/ReadModelHarness.hs view

file too large to diff

test/conformance-router-full/Generated/IncidentPaging/ServiceOncall/ReadModelTable.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/BehaviorSourceMap.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/Page/BehaviorContract.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/Page/Codec.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/Page/Domain.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/Page/EventStream.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/Page/Harness.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/Page/Projection.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/Page/Transducer.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/PagingRouter/Router.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/PagingRouter/RouterHarness.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/ReplayAudit.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/ServiceOncall/ReadModel.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/ServiceOncall/ReadModelHarness.hs view

file too large to diff

test/conformance-router-runtime/Generated/IncidentPaging/ServiceOncall/ReadModelTable.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/BehaviorSourceMap.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/Page/BehaviorContract.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/Page/Codec.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/Page/Domain.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/Page/EventStream.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/Page/Harness.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/Page/Projection.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/Page/Transducer.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/PagingRouter/Router.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/PagingRouter/RouterHarness.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/ReplayAudit.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/ServiceOncall/ReadModel.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/ServiceOncall/ReadModelHarness.hs view

file too large to diff

test/conformance-router/Generated/IncidentPaging/ServiceOncall/ReadModelTable.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/BehaviorSourceMap.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/Nominals.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/Nominals/Internal.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ReplayAudit.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/BehaviorContract.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Codec.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Domain.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/EventStream.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Harness.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Projection.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Transducer.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/Structural/Shape/Limits.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/StructuralConformance.hs view

file too large to diff

test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/StructuralProjections.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/BehaviorContract.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Codec.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Domain.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/EventStream.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Harness.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Projection.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Transducer.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/AlphaView/Generated/ReadModel.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/AlphaView/Generated/ReadModelHarness.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/AlphaView/Generated/ReadModelTable.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/BehaviorContract.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Codec.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Domain.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/EventStream.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Harness.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Projection.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Transducer.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/BetaView/Generated/ReadModel.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/BetaView/Generated/ReadModelHarness.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/BetaView/Generated/ReadModelTable.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/BehaviorSourceMap.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/Conformance.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/Nominals.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/Nominals/Internal.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/ReplayAudit.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/WorkspaceProofWorkflow/Generated/WorkflowFacts.hs view

file too large to diff

test/conformance-service-package/runtime/src/Proof/WorkspaceProof/WorkspaceProofWorkflow/Generated/WorkflowRuntime.hs view

file too large to diff

test/conformance-service-package/runtime/src/keiro-dsl-conformance.workspace.workspace-proof/keiro-dsl-conformance-ledger.txt view

file too large to diff

test/conformance-service-package/runtime/src/keiro-dsl-conformance.workspace.workspace-proof/keiro-workspace-proof-conformance.cabal view

file too large to diff

test/conformance-service-package/runtime/src/keiro-dsl-conformance.workspace.workspace-proof/src/Main.hs view

file too large to diff

test/conformance-skeletons/SkelQueue/Generated/MyService/ReservationWork/QueuePolicy.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/BehaviorSourceMap.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Nominals.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Nominals/Internal.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/ReplayAudit.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Reservation/BehaviorContract.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Codec.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Domain.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Reservation/EventStream.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Harness.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Projection.hs view

file too large to diff

test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Transducer.hs view

file too large to diff

+ test/conformance-structural-nominals/Conformance/StructuralNominals/Bindings.hs view

file too large to diff

+ test/conformance-structural-nominals/Conformance/StructuralNominals/Domain.hs view

file too large to diff

+ test/conformance-structural-nominals/Conformance/StructuralNominals/Historical.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/BehaviorSourceMap.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Nominal/Shape/Channel.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/NominalProjections.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Nominals.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Nominals/Internal.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/ProjectionCatalog.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/ReplayAudit.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Structural/CodecCompare/TemplateState.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Structural/NominalLeaves.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Structural/Shape/TemplateBook.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Structural/Shape/TemplateLookupInput.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Structural/Shape/TemplateLookupRow.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Structural/Shape/TemplateRef.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/Structural/Shape/TemplateState.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/StructuralConformance.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/StructuralProjections.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateCatalog/BehaviorContract.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateCatalog/Codec.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateCatalog/Domain.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateCatalog/EventStream.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateCatalog/Harness.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateCatalog/Projection.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateCatalog/Transducer.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateDeliveryRouter/Router.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateDeliveryRouter/RouterHarness.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateLookup/QueryContract.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateLookup/ReadModel.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateLookup/ReadModelHarness.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateLookup/ReadModelTable.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateWork/Queue.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateWork/QueueCodec.hs view

file too large to diff

+ test/conformance-structural-nominals/Generated/StructuralNominalLeaves/TemplateWork/QueuePolicy.hs view

file too large to diff

+ test/conformance-structural-nominals/Main.hs view

file too large to diff

+ test/conformance-structural-nominals/StructuralNominalLeaves/ProjectionCatalog/ProjectionCatalogHoles.hs view

file too large to diff

+ test/conformance-structural-nominals/StructuralNominalLeaves/TemplateCatalog/BehaviorHoles.hs view

file too large to diff

+ test/conformance-structural-nominals/StructuralNominalLeaves/TemplateLookup/ReadModelHoles.hs view

file too large to diff

+ test/conformance-structural-nominals/fixtures/codec-compare-malformed/template-state-wrong-prefix.json view

file too large to diff

+ test/conformance-structural-nominals/fixtures/codec-compare/template-state-missing-holder.json view

file too large to diff

+ test/conformance-structural-nominals/fixtures/codec-compare/template-state-null-holder.json view

file too large to diff

+ test/conformance-structural-nominals/fixtures/codec-compare/template-state-present-holder.json view

file too large to diff

+ test/conformance-structural-nominals/keiro-dsl-cabal-fragment.context.structural-nominal-leaves.txt view

file too large to diff

+ test/conformance-structural-nominals/keiro-dsl-ledger.context.structural-nominal-leaves.txt view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/BehaviorContract.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Codec.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Domain.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/EventStream.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Harness.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Projection.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Transducer.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/BehaviorSourceMap.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/ReplayAudit.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/Structural/Shape/ArtifactInfo.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/Structural/Shape/ArtifactKind.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/Structural/Shape/ArtifactLocation.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/Structural/Shape/ArtifactMetadata.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/StructuralConformance.hs view

file too large to diff

test/conformance-structural/Generated/StructuralConformance/StructuralProjections.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/BehaviorSourceMap.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Nominals.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Nominals/Internal.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/ReplayAudit.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Reservation/BehaviorContract.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Reservation/Codec.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Reservation/Domain.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Reservation/EventStream.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Reservation/Harness.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Reservation/Projection.hs view

file too large to diff

test/conformance-v2/Generated/HospitalCapacity/Reservation/Transducer.hs view

file too large to diff

test/conformance-workflow-full/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowFacts.hs view

file too large to diff

test/conformance-workflow-full/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowRuntime.hs view

file too large to diff

test/conformance-workflow-runtime/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowFacts.hs view

file too large to diff

test/conformance-workflow-runtime/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowRuntime.hs view

file too large to diff

test/conformance-workflow/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowFacts.hs view

file too large to diff

test/conformance-workflow/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowRuntime.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/BehaviorSourceMap.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Nominals.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Nominals/Internal.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/BehaviorContract.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Codec.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Domain.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/EventStream.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Harness.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Projection.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Transducer.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/BehaviorContract.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Codec.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Domain.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/EventStream.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Harness.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Projection.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Transducer.hs view

file too large to diff

test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ReplayAudit.hs view

file too large to diff

+ test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Structural/NominalLeaves.hs view

file too large to diff

+ test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Structural/Shape/ArtifactClaim.hs view

file too large to diff

+ test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Structural/Shape/ProjectClaim.hs view

file too large to diff

+ test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/StructuralConformance.hs view

file too large to diff

+ test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/StructuralProjections.hs view

file too large to diff

test/conformance-workspace-nominals/Main.hs view

file too large to diff

+ test/conformance-workspace-nominals/WorkspaceNominalProof/Bindings.hs view

file too large to diff

+ test/conformance-workspace-nominals/WorkspaceNominalProof/Domain.hs view

file too large to diff

test/conformance-workspace-nominals/WorkspaceNominalProof/Project/BehaviorHoles.hs view

file too large to diff

test/conformance-workspace-nominals/WorkspaceNominalProof/ProjectArtifact/BehaviorHoles.hs view

file too large to diff

test/conformance-workspace-nominals/keiro-dsl-cabal-fragment.workspace.workspace-nominal-proof.txt view

file too large to diff

test/conformance-workspace-nominals/keiro-dsl-ledger.workspace.workspace-nominal-proof.txt view

file too large to diff

test/conformance/Generated/HospitalCapacity/BehaviorSourceMap.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Nominals.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Nominals/Internal.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/ReplayAudit.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Reservation/BehaviorContract.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Reservation/Codec.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Reservation/Domain.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Reservation/EventStream.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Reservation/Harness.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Reservation/Projection.hs view

file too large to diff

test/conformance/Generated/HospitalCapacity/Reservation/Transducer.hs view

file too large to diff

test/diff-test.sh view

file too large to diff

test/fixtures/check-report/legacy-min-language.golden.json view

file too large to diff

test/fixtures/compatibility-vector.diff.golden view

file too large to diff

+ test/fixtures/contract-declared-id-language5.keiro view

file too large to diff

+ test/fixtures/contract-declared-id-literal-to-declared.keiro view

file too large to diff

+ test/fixtures/contract-declared-id-prefix-change.keiro view

file too large to diff

+ test/fixtures/contract-declared-id.keiro view

file too large to diff

+ test/fixtures/direct-optional-id.keiro view

file too large to diff

test/fixtures/fold-identity-baseline.golden view

file too large to diff

+ test/fixtures/guard-remedy-unavailable-new.keiro view

file too large to diff

+ test/fixtures/guard-remedy-unavailable-old.keiro view

file too large to diff

+ test/fixtures/hospital-surge-reactions.keiro view

file too large to diff

+ test/fixtures/intake-delegated.keiro view

file too large to diff

+ test/fixtures/mapped-keyed-map-enum-key.keiro view

file too large to diff

+ test/fixtures/mapped-keyed-map-language5.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-leaf-default.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-leaf-enum-language.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-leaf-enum.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-leaf-language.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-leaf.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-query-only-enum.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-query-only-language.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-query-only.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-queue-only-enum.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-queue-only-language.keiro view

file too large to diff

+ test/fixtures/mapped-nominal-queue-only.keiro view

file too large to diff

+ test/fixtures/nested-nominal-guard-mismatched-id.keiro view

file too large to diff

+ test/fixtures/nested-nominal-guard-optional-path.keiro view

file too large to diff

+ test/fixtures/nested-nominal-guard-ordering.keiro view

file too large to diff

+ test/fixtures/process-reactions-accepted-requires-event.keiro view

file too large to diff

+ test/fixtures/process-reactions-accepted-unverified.keiro view

file too large to diff

+ test/fixtures/process-reactions-badmapping.keiro view

file too large to diff

+ test/fixtures/process-reactions-cancel-unknown.keiro view

file too large to diff

+ test/fixtures/process-reactions-diff.keiro view

file too large to diff

+ test/fixtures/process-reactions-duplicate-input-declaration.keiro view

file too large to diff

+ test/fixtures/process-reactions-duplicate-on.keiro view

file too large to diff

+ test/fixtures/process-reactions-duplicate-timer.keiro view

file too large to diff

+ test/fixtures/process-reactions-fanout-changed.keiro view

file too large to diff

+ test/fixtures/process-reactions-guard-not-boolean.keiro view

file too large to diff

+ test/fixtures/process-reactions-input-unhandled.keiro view

file too large to diff

+ test/fixtures/process-reactions-language5.keiro view

file too large to diff

+ test/fixtures/process-reactions-minimal.keiro view

file too large to diff

+ test/fixtures/process-reactions-otherwise-missing.keiro view

file too large to diff

+ test/fixtures/process-reactions-otherwise-unreachable.keiro view

file too large to diff

+ test/fixtures/process-reactions-payload-incomplete.keiro view

file too large to diff

+ test/fixtures/process-reactions-reordered-unversioned.keiro view

file too large to diff

+ test/fixtures/process-reactions-reordered.keiro view

file too large to diff

+ test/fixtures/process-reactions-schedule-unknown.keiro view

file too large to diff

+ test/fixtures/process-reactions-silent-missing.keiro view

file too large to diff

+ test/fixtures/process-reactions-state-access.keiro view

file too large to diff

+ test/fixtures/process-reactions-timer-policy-missing.keiro view

file too large to diff

+ test/fixtures/process-reactions-timer-policy-unused.keiro view

file too large to diff

+ test/fixtures/process-reactions-timer-prefix-collision.keiro view

file too large to diff

+ test/fixtures/process-reactions-unknown-input.keiro view

file too large to diff

+ test/fixtures/process-reactions.keiro view

file too large to diff

+ test/fixtures/process-state-authority.keiro view

file too large to diff

+ test/fixtures/process-timers-identity-changed.keiro view

file too large to diff

+ test/fixtures/process-timers-payload-changed.keiro view

file too large to diff

+ test/fixtures/process-timers.keiro view

file too large to diff

+ test/fixtures/reservation-guard-tightened-partial-twin.keiro view

file too large to diff

test/fixtures/reservation-guard-tightened-twin.keiro view

file too large to diff

+ test/fixtures/structural-nominal-leaves-binding-change.keiro view

file too large to diff

+ test/fixtures/structural-nominal-leaves-enum-spelling.keiro view

file too large to diff

+ test/fixtures/structural-nominal-leaves-keyed-map-key-change.keiro view

file too large to diff

+ test/fixtures/structural-nominal-leaves-opaque-to-nominal.keiro view

file too large to diff

+ test/fixtures/structural-nominal-leaves-prefix-change.keiro view

file too large to diff

+ test/fixtures/structural-nominal-leaves-text-to-nominal.keiro view

file too large to diff

+ test/fixtures/structural-nominal-leaves.keiro view

file too large to diff

+ test/fixtures/transition-family-additive.keiro view

file too large to diff

+ test/fixtures/transition-family-ambiguous-new.keiro view

file too large to diff

+ test/fixtures/transition-family-ambiguous-old.keiro view

file too large to diff

+ test/fixtures/transition-family-no-emit-tightened.keiro view

file too large to diff

+ test/fixtures/transition-family-outcome-new.keiro view

file too large to diff

+ test/fixtures/transition-family-outcome-old.keiro view

file too large to diff

+ test/fixtures/transition-family.keiro view

file too large to diff

+ test/fixtures/workqueue-fifo-heads.keiro view

file too large to diff

test/fixtures/workspace-nominals/domain/project-artifact.keiro view

file too large to diff

test/fixtures/workspace-nominals/domain/project.keiro view

file too large to diff

test/fixtures/workspace-nominals/domain/shared.keiro view

file too large to diff

test/keiro-dsl-codec-compare-artifact-info.cabal view

file too large to diff

+ test/process-hydration-test.sh view

file too large to diff

+ test/process-reaction-mutation-test.sh view

file too large to diff

+ test/structural-nominal-key-ordering-mutation-test.sh view

file too large to diff

+ test/structural-nominal-mutation-test.sh view

file too large to diff