DiffReport.hs

-- | Pure rendering and JSON encoding for compatibility-vector diff reports.
--
-- The JSON schema identifier is @keiro-dsl/diff-report/1@.  Consumers must
-- ignore unknown object keys.  Vector keys and entries in the @paths@ array are
-- append-only so later nested type-expression work can refine findings without
-- invalidating version-1 readers. Workspace inputs add a top-level @workspace@
-- object and optional per-finding @declaration@ and @useSites@ keys; single-file
-- reports keep their original bytes.
module Keiro.Dsl.DiffReport
  ( Remedy (..),
    DiffReport,
    diffReport,
    diffReportWithSemanticImpact,
    diffReportWithCoordinationImpact,
    diffReportWithImpacts,
    OwnedSite (..),
    WorkspaceChange (..),
    WorkspaceMeta (..),
    WorkspaceDiffReport,
    workspaceDiffReport,
    workspaceDiffReportWithSemanticImpact,
    workspaceDiffReportWithCoordinationImpact,
    workspaceDiffReportWithImpacts,
    remediationFor,
    renderRemedy,
    renderFinding,
    renderVectorLine,
    renderExplainBlock,
    renderSemanticImpact,
    renderCoordinationImpact,
    surfaceName,
    parseSurfaceName,
    verdictName,
    rolloutName,
  )
where

import Data.Aeson (ToJSON (..), Value, object, (.=))
import Data.Aeson.Types (Pair)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import Keiro.Dsl.CoordinationImpact (CoordinationImpact (..), CoordinationSeverity (..), renderCoordinationImpact)
import Keiro.Dsl.Diff
import Keiro.Dsl.SemanticImpact (MappedImpactDelta (..), MappedRootEvidence (..), mappedConsequenceIdentity, mappedConsumerIdentity, mappedRootKindIdentity)
import Keiro.Dsl.TypeGraph (MappedKey (..))
import Keiro.Dsl.Validate (DiagnosticCode (..))

data Remedy
  = RemedyVersionBump
  | RemedyUpcaster
  | RemedyDeploymentOrder RolloutConstraint
  | RemedyContractRevision
  | RemedyReplayOnlyEdge
  | RemedyStateCodecBump
  | RemedyRecompileConsumers
  | RemedyRescaffoldGenerated
  | RemedyRescaffoldWorkspace
  | RemedyRunConformance
  | RemedyNoSemanticAction
  | RemedyDoNotDeploy Text
  | RemedyEmitContractTypeIdDomain
  | RemedyDrainLegacyInvalidContractMessages
  | RemedyRescaffoldContractConsumers
  | RemedyRunContractConformance
  | RemedyDrainWorkqueue
  | RemedyTransitionalQueueCodec
  deriving stock (Eq, Show)

data DiffReport = DiffReport
  { reportGate :: !(Set CompatibilitySurface),
    reportFindings :: ![Change],
    reportSemanticImpact :: !(Maybe [MappedImpactDelta]),
    reportCoordinationImpact :: !(Maybe [CoordinationImpact])
  }
  deriving stock (Eq, Show)

diffReport :: Set CompatibilitySurface -> [Change] -> DiffReport
diffReport gate findings = DiffReport gate findings Nothing Nothing

-- | Add the append-only semantic-impact object used by current CLI reports.
-- The older smart constructor intentionally omits it for source compatibility.
diffReportWithSemanticImpact :: Set CompatibilitySurface -> [Change] -> [MappedImpactDelta] -> DiffReport
diffReportWithSemanticImpact gate findings impact = DiffReport gate findings (Just impact) Nothing

diffReportWithCoordinationImpact :: Set CompatibilitySurface -> [Change] -> [CoordinationImpact] -> DiffReport
diffReportWithCoordinationImpact gate findings impact = DiffReport gate findings Nothing (Just impact)

diffReportWithImpacts :: Set CompatibilitySurface -> [Change] -> [MappedImpactDelta] -> [CoordinationImpact] -> DiffReport
diffReportWithImpacts gate findings semantic coordination = DiffReport gate findings (Just semantic) (Just coordination)

-- | One source location from a composed workspace's ownership index.
data OwnedSite = OwnedSite
  { osFile :: !FilePath,
    osLine :: !Int
  }
  deriving stock (Eq, Show)

-- | A merged-graph finding enriched with declaration and use-site ownership.
data WorkspaceChange = WorkspaceChange
  { wcChange :: !Change,
    wcDeclarationSite :: !(Maybe OwnedSite),
    wcUseSites :: ![(Text, Maybe OwnedSite)]
  }
  deriving stock (Eq, Show)

-- | Provenance for the two workspace graphs compared by one command.
data WorkspaceMeta = WorkspaceMeta
  { wmIdentity :: !Text,
    wmManifest :: !FilePath,
    wmSince :: !Text,
    wmMembersOld :: ![FilePath],
    wmMembersNew :: ![FilePath],
    wmAdoptionBaseline :: !Bool
  }
  deriving stock (Eq, Show)

data WorkspaceDiffReport = WorkspaceDiffReport
  { workspaceReportMeta :: !WorkspaceMeta,
    workspaceReportGate :: !(Set CompatibilitySurface),
    workspaceReportFindings :: ![WorkspaceChange],
    workspaceReportSemanticImpact :: !(Maybe [MappedImpactDelta]),
    workspaceReportCoordinationImpact :: !(Maybe [CoordinationImpact])
  }
  deriving stock (Eq, Show)

workspaceDiffReport :: WorkspaceMeta -> Set CompatibilitySurface -> [WorkspaceChange] -> WorkspaceDiffReport
workspaceDiffReport meta gate findings = WorkspaceDiffReport meta gate findings Nothing Nothing

workspaceDiffReportWithSemanticImpact :: WorkspaceMeta -> Set CompatibilitySurface -> [WorkspaceChange] -> [MappedImpactDelta] -> WorkspaceDiffReport
workspaceDiffReportWithSemanticImpact meta gate findings impact = WorkspaceDiffReport meta gate findings (Just impact) Nothing

workspaceDiffReportWithCoordinationImpact :: WorkspaceMeta -> Set CompatibilitySurface -> [WorkspaceChange] -> [CoordinationImpact] -> WorkspaceDiffReport
workspaceDiffReportWithCoordinationImpact meta gate findings impact = WorkspaceDiffReport meta gate findings Nothing (Just impact)

workspaceDiffReportWithImpacts :: WorkspaceMeta -> Set CompatibilitySurface -> [WorkspaceChange] -> [MappedImpactDelta] -> [CoordinationImpact] -> WorkspaceDiffReport
workspaceDiffReportWithImpacts meta gate findings semantic coordination = WorkspaceDiffReport meta gate findings (Just semantic) (Just coordination)

instance ToJSON DiffReport where
  toJSON report =
    object $
      [ "schema" .= ("keiro-dsl/diff-report/1" :: Text),
        "gate" .= map surfaceName (Set.toAscList (reportGate report)),
        "breaking" .= (any (gatedBreaking (reportGate report)) (reportFindings report) || coordinationBreaking (reportCoordinationImpact report)),
        "findings" .= map (findingValue (reportGate report)) (reportFindings report)
      ]
        <> ["semanticImpact" .= semanticImpactValue impact | Just impact <- [reportSemanticImpact report]]
        <> ["coordinationImpact" .= impact | Just impact <- [reportCoordinationImpact report]]

instance ToJSON WorkspaceDiffReport where
  toJSON report =
    object $
      [ "schema" .= ("keiro-dsl/diff-report/1" :: Text),
        "gate" .= map surfaceName (Set.toAscList (workspaceReportGate report)),
        "breaking" .= (any (gatedBreaking (workspaceReportGate report) . wcChange) (workspaceReportFindings report) || coordinationBreaking (workspaceReportCoordinationImpact report)),
        "findings" .= map (workspaceFindingValue (workspaceReportGate report)) (workspaceReportFindings report),
        "workspace" .= workspaceMetaValue (workspaceReportMeta report)
      ]
        <> ["semanticImpact" .= semanticImpactValue impact | Just impact <- [workspaceReportSemanticImpact report]]
        <> ["coordinationImpact" .= impact | Just impact <- [workspaceReportCoordinationImpact report]]

semanticImpactValue :: [MappedImpactDelta] -> Value
semanticImpactValue impact = object ["declarations" .= impact]

coordinationBreaking :: Maybe [CoordinationImpact] -> Bool
coordinationBreaking = maybe False (any ((== CoordinationBreaking) . coordinationSeverity))

-- | Human-facing semantic dependency summary, kept separate from ordinary
-- compatibility findings and generated-file evidence.
renderSemanticImpact :: [MappedImpactDelta] -> [Text]
renderSemanticImpact [] = []
renderSemanticImpact impact = "semantic impact:" : concatMap renderDelta impact
  where
    renderDelta delta =
      [ "  " <> unMappedKey (impactDeclaration delta),
        "    previous aggregate consumers: " <> renderBaseline (impactPreviousEvidence delta) (renderConsumers (impactPreviousConsumers delta)),
        "    current aggregate consumers:  " <> renderConsumers (impactCurrentConsumers delta),
        "    previous roots: " <> maybe "baseline unavailable" renderEvidence (impactPreviousEvidence delta),
        "    current roots:  " <> maybe "baseline unavailable" renderEvidence (impactCurrentEvidence delta),
        "    previous consequences: " <> maybe "baseline unavailable" renderConsequences (impactPreviousConsequences delta),
        "    current consequences:  " <> maybe "baseline unavailable" renderConsequences (impactCurrentConsequences delta),
        "    service-conformance: " <> if impactServiceConformance delta then "impacted" else "unchanged"
      ]
    renderConsumers aggregateConsumers = case map consumerName (Set.toAscList aggregateConsumers) of
      [] -> "(none)"
      names -> T.intercalate ", " names
    consumerName = mappedConsumerIdentity
    renderBaseline Nothing _ = "baseline unavailable"
    renderBaseline (Just _) value = value
    renderEvidence values = renderSet renderRoot values
    renderRoot evidence =
      T.intercalate "|" [mappedRootKindIdentity (evidenceRootKind evidence), mappedConsumerIdentity (evidenceConsumer evidence), evidencePath evidence]
        <> maybe "" ("|" <>) (evidenceOperation evidence)
    renderConsequences = renderSet mappedConsequenceIdentity
    renderSet render values = case map render (Set.toAscList values) of
      [] -> "(none)"
      rendered -> T.intercalate ", " rendered

findingValue :: Set CompatibilitySurface -> Change -> Value
findingValue gate change = object (findingPairs gate change)

workspaceFindingValue :: Set CompatibilitySurface -> WorkspaceChange -> Value
workspaceFindingValue gate workspaceChange =
  object
    ( findingPairs gate (wcChange workspaceChange)
        <> maybe [] (\site -> ["declaration" .= ownedSiteValue site]) (wcDeclarationSite workspaceChange)
        <> ["useSites" .= map useSiteValue (wcUseSites workspaceChange) | not (null (wcUseSites workspaceChange))]
    )

findingPairs :: Set CompatibilitySurface -> Change -> [Pair]
findingPairs gate change =
  [ "label" .= labelName (deriveLabel gate (ckVector kind)),
    "node" .= ckNode kind,
    "facet" .= ckFacet kind,
    "subject" .= ckSubject kind,
    "code" .= T.pack (show (ckCode kind)),
    "paths" .= ckPaths kind,
    "vector" .= vectorValue (ckVector kind),
    "detail" .= ckDetail kind,
    "remedies" .= map renderRemedy (NonEmpty.toList (remediationFor (ckContext kind) (ckCode kind)))
  ]
    <> ["mappedPersistedSurface" .= mappedPersistedImpactValue impact | Just impact <- [ckMappedPersistedImpact kind]]
    <> ["mappedConsequences" .= map mappedConsequenceIdentity (Set.toAscList (ckMappedConsequences kind)) | not (Set.null (ckMappedConsequences kind))]
  where
    kind = changeKind change

ownedSiteValue :: OwnedSite -> Value
ownedSiteValue site = object ["file" .= osFile site, "line" .= osLine site]

useSiteValue :: (Text, Maybe OwnedSite) -> Value
useSiteValue (path, site) =
  object
    ( ["path" .= path]
        <> maybe [] (\owned -> ["file" .= osFile owned, "line" .= osLine owned]) site
    )

mappedPersistedImpactValue :: MappedPersistedImpact -> Value
mappedPersistedImpactValue impact =
  object
    [ "surface" .= persistedSurfaceName (mappedPersistedSurface impact),
      "verdict" .= verdictName (mappedPersistedVerdict impact)
    ]

persistedSurfaceName :: MappedPersistedSurface -> Text
persistedSurfaceName PrivateEventHistory = "private-event-history"
persistedSurfaceName SnapshotCache = "snapshot-cache"
persistedSurfaceName (WorkqueueHistory name) = "workqueue-history:" <> name

workspaceMetaValue :: WorkspaceMeta -> Value
workspaceMetaValue meta =
  object
    [ "identity" .= wmIdentity meta,
      "manifest" .= wmManifest meta,
      "since" .= wmSince meta,
      "membersOld" .= wmMembersOld meta,
      "membersNew" .= wmMembersNew meta,
      "adoptionBaseline" .= wmAdoptionBaseline meta
    ]

vectorValue :: CompatibilityVector -> Value
vectorValue vector =
  object
    [ "private-history-read" .= verdictName (cvPrivateHistoryRead vector),
      "old-binary-read-new-events" .= verdictName (cvOldBinaryReadNewEvents vector),
      "snapshot-hydration" .= verdictName (cvSnapshotHydration vector),
      "public-consumer" .= verdictName (cvPublicConsumer vector),
      "persisted-identity" .= verdictName (cvPersistedIdentity vector),
      "consumer-build" .= verdictName (cvConsumerBuild vector),
      "rollout" .= map rolloutName (Set.toAscList (cvRollout vector))
    ]

remediationFor :: ChangeContext -> DiagnosticCode -> NonEmpty Remedy
remediationFor context code
  | code == SourceLanguageDeclarationChanged = RemedyNoSemanticAction :| []
  | code == GeneratedHaskellNameChanged = RemedyRescaffoldGenerated :| [RemedyRecompileConsumers, RemedyRunConformance]
  | code == OwnershipMoved = RemedyRescaffoldWorkspace :| []
  | code == WorkspaceAuthorityChanged = RemedyRescaffoldWorkspace :| [RemedyRecompileConsumers]
  | code == AggGuardTightened = RemedyReplayOnlyEdge :| [RemedyRunConformance]
  | code == AggFoldSurfaceChanged = RemedyStateCodecBump :| [RemedyRunConformance]
  | code == IdDomainContractChanged =
      RemedyDeploymentOrder RolloutProducerLast :| [RemedyStateCodecBump, RemedyRecompileConsumers, RemedyRunConformance]
  | code == ContractTypeIdDomainChanged =
      RemedyEmitContractTypeIdDomain
        :| [ RemedyDrainLegacyInvalidContractMessages,
             RemedyRescaffoldContractConsumers,
             RemedyRunContractConformance
           ]
  | code == CatalogCheckpointPolicyChanged =
      RemedyDeploymentOrder RolloutStopTheWorld
        :| [RemedyRescaffoldGenerated, RemedyRecompileConsumers, RemedyRunConformance]
  | code `elem` mappedWireCodes = mappedWireRemedy
  | code `elem` [MappedFieldAddedWithDefault, MappedArmAdded, MappedEnumValueAdded] = mappedAdditionRemedy
  | code `elem` [MappedHaskellSourceChanged, MappedRecordConstructorChanged] =
      RemedyRecompileConsumers :| [RemedyRunConformance]
  | code == MappedBindingChanged = mappedConformanceRemedy
  | code == MappedFixturesChanged = RemedyRunConformance :| []
  | code == MappedInitialChanged = mappedSnapshotConformanceRemedy
  | code == MappedCanonicalTypeChanged = mappedCanonicalRemedy
  | code == MappedDeclAdded = RemedyRunConformance :| []
  | code `elem` eventDecodeCodes =
      RemedyVersionBump :| [RemedyUpcaster, RemedyDeploymentOrder RolloutStopTheWorld]
  | code `elem` contractCodes =
      RemedyContractRevision :| [RemedyDeploymentOrder RolloutProducerLast]
  | code `elem` queueCodes =
      RemedyDeploymentOrder RolloutWorkersFirst :| [RemedyDrainWorkqueue, RemedyTransitionalQueueCodec, RemedyRunConformance]
  | code `elem` identityCodes =
      RemedyDoNotDeploy "revert the re-keying change or perform an explicit operational identity migration" :| []
  | code == EnumCtorAdded = case Set.toAscList (cvRollout vector) of
      rollout : _ -> RemedyDeploymentOrder rollout :| [snapshotRemedy]
      [] -> snapshotRemedy :| []
  | cvConsumerBuild vector `elem` [VAdvisory, VBreaking] =
      RemedyRecompileConsumers :| [RemedyRunConformance]
  | Just rollout <- firstRollout = RemedyDeploymentOrder rollout :| [RemedyRunConformance]
  | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]
  | otherwise = RemedyRunConformance :| []
  where
    vector = classifyCompatibility context code
    firstRollout = case Set.toAscList (cvRollout vector) of
      rollout : _ -> Just rollout
      [] -> Nothing
    snapshotRemedy
      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump
      | otherwise = RemedyRunConformance
    mappedWireRemedy
      | Set.member RolloutDrainRequired (cvRollout vector) = queueMappedRemedy
      | cvPrivateHistoryRead vector == VBreaking =
          RemedyVersionBump :| [RemedyUpcaster, RemedyDeploymentOrder RolloutStopTheWorld]
      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]
      | otherwise = RemedyRecompileConsumers :| [RemedyRunConformance]
    mappedAdditionRemedy
      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]
      | Set.member RolloutDrainRequired (cvRollout vector) = queueMappedRemedy
      | Just rollout <- firstRollout = RemedyDeploymentOrder rollout :| [RemedyRunConformance]
      | otherwise = RemedyRunConformance :| []
    mappedConformanceRemedy
      | cvSnapshotHydration vector == VAdvisory = RemedyRunConformance :| [RemedyStateCodecBump]
      | Set.member RolloutDrainRequired (cvRollout vector) = queueMappedRemedy
      | otherwise = RemedyRunConformance :| []
    queueMappedRemedy =
      RemedyDeploymentOrder RolloutWorkersFirst
        :| [RemedyDrainWorkqueue, RemedyTransitionalQueueCodec, RemedyRecompileConsumers, RemedyRunConformance]
    mappedSnapshotConformanceRemedy
      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]
      | otherwise = RemedyRunConformance :| []
    mappedCanonicalRemedy
      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRecompileConsumers, RemedyRunConformance]
      | otherwise = RemedyRecompileConsumers :| [RemedyRunConformance]
    mappedWireCodes =
      [ MappedFieldAddedNoDefault,
        MappedFieldRemoved,
        MappedFieldTypeChanged,
        MappedPresenceChanged,
        MappedNullabilityChanged,
        MappedDefaultRemoved,
        MappedDefaultChanged,
        MappedWireKeyChanged,
        MappedUnionEncodingChanged,
        MappedArmRemoved,
        MappedArmTagChanged,
        MappedEnumValueRemoved,
        MappedEnumSpellingChanged,
        MappedOpaqueCodecChanged,
        MappedModeCrossed,
        MappedDeclRemoved
      ]
    eventDecodeCodes =
      [ EvtFieldAddedWithoutBump,
        EvtFieldRemovedSameVersion,
        EvtFieldWireKeyChanged,
        EvtFieldTypeChanged,
        EvtVersionDecreased,
        EvtVersionMissingUpcaster,
        UpcasterChainGap,
        EvtRemovedNotDeprecated,
        EnumCtorRemoved,
        EnumWireSpellingChanged,
        WireSpecChanged,
        ProcessInputChanged,
        WorkflowShapeChanged,
        WorkflowBodyChanged,
        WorkflowPatchRemoved,
        WorkflowContinueSeedChanged
      ]
    contractCodes =
      [ ContractEventRemoved,
        ContractFieldChanged,
        ContractDiscriminatorChanged,
        ContractTopicChanged,
        ContractSchemaVersionDecreased,
        ContractSchemaVersionBumped
      ]
    queueCodes = [WqPayloadFieldChanged, WqOrderingChanged, WqProvisionChanged, WqGroupKeyChanged, QueueIdentityChanged]
    identityCodes =
      [ DerivedIdentityChanged,
        IdPrefixChanged,
        DedupeIdentityChanged,
        RouterStableNameChanged,
        WorkflowStableNameChanged,
        ReadModelVersionDecreased,
        ReadModelShapeChangedWithoutBump,
        ReadModelFeedChanged,
        ReadModelConsistencyWeakened
      ]

renderRemedy :: Remedy -> Text
renderRemedy remedy = case remedy of
  RemedyVersionBump -> "bump the owning schema or event version"
  RemedyUpcaster -> "add and retain a contiguous upcaster for every historical version"
  RemedyDeploymentOrder rollout -> "deploy in " <> rolloutName rollout <> " order"
  RemedyContractRevision -> "revise the independently owned public contract"
  RemedyReplayOnlyEdge -> "add the computed replay-only edge described by docs/adr/0002-replay-only-edges-are-the-sanctioned-remedy-for-guard-tightening.md"
  RemedyStateCodecBump -> "invalidate and rebuild snapshots by bumping state-codec version when automatic fingerprinting cannot see the change"
  RemedyRecompileConsumers -> "recompile every affected consumer against the generated interface"
  RemedyRescaffoldGenerated -> "re-run the scaffold so generated modules and create-once imports use the candidate Haskell names"
  RemedyRescaffoldWorkspace -> "re-run the whole-workspace scaffold so the record's ownership and golden roots follow the change"
  RemedyRunConformance -> "run the generated conformance and historical fixture suites"
  RemedyNoSemanticAction -> "no semantic action is required; only source-language provenance changed"
  RemedyDoNotDeploy detail -> detail
  RemedyEmitContractTypeIdDomain -> "make all producers emit the frozen TypeID-v7 domain"
  RemedyDrainLegacyInvalidContractMessages -> "drain or remediate legacy-invalid in-flight messages"
  RemedyRescaffoldContractConsumers -> "re-scaffold and recompile every affected consumer against the generated interface"
  RemedyRunContractConformance -> "run contract conformance"
  RemedyDrainWorkqueue -> "drain incompatible queued jobs before deployment"
  RemedyTransitionalQueueCodec -> "supply an application-owned transitional queue codec when draining is impossible"

renderFinding :: Change -> Text
renderFinding change =
  headline
    <> vectorDetail
    <> persistedDetail
    <> consequenceDetail
  where
    kind = changeKind change
    headline =
      headlineName change
        <> ": "
        <> ckNode kind
        <> " "
        <> ckFacet kind
        <> " "
        <> ckSubject kind
        <> ": "
        <> ckDetail kind
        <> codeSuffix change kind
    vectorDetail
      | vectorIsUniform (ckVector kind) = ""
      | otherwise = "\n" <> renderVectorLine (ckVector kind)
    persistedDetail = case ckMappedPersistedImpact kind of
      Nothing -> ""
      Just impact ->
        "\n    mapped-persisted-surface: "
          <> persistedSurfaceName (mappedPersistedSurface impact)
          <> "="
          <> verdictName (mappedPersistedVerdict impact)
    consequenceDetail
      | Set.null (ckMappedConsequences kind) = ""
      | otherwise =
          "\n    mapped-consequences: "
            <> T.intercalate ", " (map mappedConsequenceIdentity (Set.toAscList (ckMappedConsequences kind)))

renderVectorLine :: CompatibilityVector -> Text
renderVectorLine vector =
  "    vector: "
    <> T.unwords
      ( [ surfaceName surface <> "=" <> verdictName verdict
        | surface <- [minBound .. maxBound],
          let verdict = verdictFor surface vector,
          verdict /= VNotApplicable
        ]
          <> ["rollout=" <> T.intercalate "," (map rolloutName (Set.toAscList (cvRollout vector))) | not (Set.null (cvRollout vector))]
      )

renderExplainBlock :: Change -> Text
renderExplainBlock change =
  "explain ["
    <> T.pack (show (ckCode kind))
    <> "]\n"
    <> T.unlines ["  path: " <> path | path <- ckPaths kind]
    <> T.unlines (map ("  direction: " <>) directions)
    <> T.unlines ["  remedy: " <> renderRemedy remedy | remedy <- NonEmpty.toList remedies]
  where
    kind = changeKind change
    vector = ckVector kind
    directions =
      [ surfaceName surface <> " is " <> verdictName verdict <> "; " <> directionMeaning surface verdict
      | surface <- [minBound .. maxBound],
        let verdict = verdictFor surface vector,
        verdict `elem` [VAdvisory, VBreaking]
      ]
    remedies = remediationFor (ckContext kind) (ckCode kind)

surfaceName :: CompatibilitySurface -> Text
surfaceName surface = case surface of
  PrivateHistoryRead -> "private-history-read"
  OldBinaryReadNewEvents -> "old-binary-read-new-events"
  SnapshotHydration -> "snapshot-hydration"
  PublicConsumer -> "public-consumer"
  PersistedIdentity -> "persisted-identity"
  ConsumerBuild -> "consumer-build"

parseSurfaceName :: String -> Either String CompatibilitySurface
parseSurfaceName raw = case lookup (T.pack raw) [(surfaceName surface, surface) | surface <- [minBound .. maxBound]] of
  Just surface -> Right surface
  Nothing ->
    Left
      ( "unknown compatibility surface '"
          <> raw
          <> "'; expected one of: "
          <> T.unpack (T.intercalate ", " (map surfaceName [minBound .. maxBound]))
      )

verdictName :: SurfaceVerdict -> Text
verdictName verdict = case verdict of
  VCompatible -> "compatible"
  VAdvisory -> "advisory"
  VBreaking -> "breaking"
  VNotApplicable -> "n/a"

rolloutName :: RolloutConstraint -> Text
rolloutName rollout = case rollout of
  RolloutStopTheWorld -> "stop-the-world"
  RolloutWorkersFirst -> "workers-first"
  RolloutDrainRequired -> "drain-required"
  RolloutProducerLast -> "producer-last"
  RolloutProducerFirst -> "producer-first"

labelName :: Label -> Text
labelName label = case label of
  LabelAdditive -> "additive"
  LabelAdvisory -> "warning"
  LabelBreaking -> "breaking"

headlineName :: Change -> Text
headlineName Additive {} = "ADDITIVE"
headlineName Advisory {} = "WARNING"
headlineName Breaking {} = "BREAKING"

codeSuffix :: Change -> ChangeKind -> Text
codeSuffix Additive {} _ = ""
codeSuffix _ kind = " [" <> T.pack (show (ckCode kind)) <> "]"

changeKind :: Change -> ChangeKind
changeKind (Additive kind) = kind
changeKind (Advisory kind) = kind
changeKind (Breaking kind) = kind

vectorIsUniform :: CompatibilityVector -> Bool
vectorIsUniform vector =
  Set.null (cvRollout vector)
    && all (`elem` [VCompatible, VNotApplicable]) [verdictFor surface vector | surface <- [minBound .. maxBound]]

directionMeaning :: CompatibilitySurface -> SurfaceVerdict -> Text
directionMeaning surface verdict = case (surface, verdict) of
  (PrivateHistoryRead, _) -> "the candidate binary may reinterpret or fail to read stored private history"
  (OldBinaryReadNewEvents, _) -> "a still-running old binary may reject events emitted by the candidate"
  (SnapshotHydration, _) -> "persisted snapshot seeds require invalidation or rebuild"
  (PublicConsumer, _) -> "an independently deployed consumer may reject the candidate contract"
  (PersistedIdentity, _) -> "replay or retry may derive a different persisted identity"
  (ConsumerBuild, _) -> "consumer or generated source must be rebuilt"