keiro-dsl-0.6.0.0: src/Keiro/Dsl/WorkspaceScaffold.hs
-- | Whole-__workspace__ scaffolding: one invocation plans and emits the
-- complete generated module set for every member of a service workspace.
--
-- The module exists separately from "Keiro.Dsl.ScaffoldRun" for a structural
-- reason, not a stylistic one: "Keiro.Dsl.Workspace" already imports
-- 'Keiro.Dsl.ScaffoldRun' (its cross-member collision check asks the planner), so
-- workspace-aware scaffolding cannot live there without a module cycle. Everything
-- it needs from the single-spec pipeline is imported, never re-implemented — the
-- refusal gates, the stale comparison, the constraint plan, the drift computation
-- — so a workspace and a single spec can never disagree about what is legal.
--
-- Two properties are true __by construction__ rather than by test:
--
-- * Emission runs once over the workspace's /merged/ 'Spec'
-- ('Keiro.Dsl.Workspace.wsMergedSpec'), so the context-level artifacts — the
-- structural projection facade and the replay-audit assembly — are emitted
-- exactly once from the complete graph. Concatenating per-member scaffolds
-- would emit them N times from N partial graphs, which is the defect this
-- module fixes.
--
-- * A one-member workspace produces exactly the single-file module set, in the
-- same order, with identical bytes and identical metadata, because it calls
-- the same emitters with the same inputs.
--
-- History is workspace-keyed ("Keiro.Dsl.WorkspaceRecord"). Each module remembers
-- which member produced it, so moving an aggregate between member files is an
-- /ownership move/ rather than a stale-plus-new pair.
--
-- Atomicity here means what it means for a single spec: every refusal is computed
-- before the first output byte changes. There are no staged temp-file writes.
module Keiro.Dsl.WorkspaceScaffold
( -- * Planning
ModuleProvenance (..),
WorkspacePlan (..),
planWorkspaceScaffold,
planWorkspaceScaffoldWithGoldens,
provenanceOwner,
-- * Golden payload roots
goldenRootDivergence,
-- * Execution
OwnershipMove (..),
WorkspaceSourceLanguageDrift (..),
WorkspaceScaffoldReport (..),
executeWorkspaceScaffold,
renderWorkspaceScaffoldReport,
)
where
import Data.List (nub, sortOn)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Keiro.Dsl.ExplainBindings (BindingHole (..), bindingHoles)
import Keiro.Dsl.Goldens (GoldenPayload)
import Keiro.Dsl.Grammar
import Keiro.Dsl.Harness (harnessForWithGoldens, harnessProcess, harnessReadModel, harnessRouter, harnessWorkflow)
import Keiro.Dsl.LanguageVersion (SourceLanguage, sourceFormText)
import Keiro.Dsl.Manifest (moduleNameOf, renderManifest)
import Keiro.Dsl.MappedConsumer (ConsumerPlan (..), consumerPlan)
import Keiro.Dsl.Scaffold
import Keiro.Dsl.ScaffoldRun
( MappingDrift (..),
Refusal (..),
StaleModule (..),
WriteDisposition (..),
constraintPlan,
mappingDrift,
missingGeneratedBanners,
newBindingObligations,
obligationKindLabel,
pureRefusals,
renderMappingIdentity,
staleAgainst,
)
import Keiro.Dsl.Validate (nodeIdentity)
import Keiro.Dsl.Workspace (WorkspaceMember (..), WorkspaceSpec (..), declarationOwner, nodeOwner)
import Keiro.Dsl.WorkspaceAdoption (MigrationReport (..), adoptedRows, adoptionReport, markLegacyRecordSuperseded, renderMigrationReport)
import Keiro.Dsl.WorkspaceRecord
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FilePath (takeDirectory, takeFileName, (</>))
--------------------------------------------------------------------------------
-- Planning
--------------------------------------------------------------------------------
-- | Which member file produced an emitted module. 'ContextLevel' means the
-- module belongs to the whole service rather than to any one member: the
-- structural projection facade, the replay-audit assembly, and any binding
-- skeleton shared by declarations owned by different members.
data ModuleProvenance
= ContextLevel
| MemberOwned !FilePath
deriving stock (Eq, Ord, Show)
-- | The owning member path, or 'Nothing' for a context-level module.
provenanceOwner :: ModuleProvenance -> Maybe FilePath
provenanceOwner ContextLevel = Nothing
provenanceOwner (MemberOwned path) = Just path
-- | The complete, refusal-free write set for one whole-workspace scaffold, with
-- each module's producing member attached.
data WorkspacePlan = WorkspacePlan
{ wpWorkspace :: !WorkspaceSpec,
wpContext :: !Context,
-- | The one golden-payload root for the whole workspace. Carried here so
-- execution can refuse a member-adjacent fixture the root lacks before it
-- writes anything.
wpGoldenRoot :: !FilePath,
wpModules :: ![(ScaffoldModule, ModuleProvenance)]
}
deriving stock (Eq, Show)
-- | 'planWorkspaceScaffoldWithGoldens' with no golden payload fixtures.
planWorkspaceScaffold :: FilePath -> Context -> WorkspaceSpec -> Either [Refusal] WorkspacePlan
planWorkspaceScaffold = planWorkspaceScaffoldWithGoldens []
-- | Plan the whole workspace: build the merged module set once, attribute each
-- module to its owning member, then run every pure refusal gate over the complete
-- set. A refusal carries no write set, so it cannot be executed by accident.
--
-- Because the gates see the whole workspace, a case-folded module-path collision
-- between two members is caught here, with both member files named in the
-- collision's origins.
planWorkspaceScaffoldWithGoldens ::
[GoldenPayload] ->
FilePath ->
Context ->
WorkspaceSpec ->
Either [Refusal] WorkspacePlan
planWorkspaceScaffoldWithGoldens goldens goldenRoot ctx workspace =
case pureRefusals ctx merged (map fst tagged) of
[] ->
Right
WorkspacePlan
{ wpWorkspace = workspace,
wpContext = ctx,
wpGoldenRoot = goldenRoot,
wpModules = tagged
}
refusals -> Left refusals
where
merged = wsMergedSpec workspace
tagged = workspaceModules goldens ctx workspace
-- | The tagged module set, in exactly the order
-- 'Keiro.Dsl.ScaffoldRun.scaffoldModulesWithGoldens' produces for the merged spec.
--
-- Attribution is structural, never a re-parse of the human-readable @origin@
-- string: structural modules carry the mapped declarations they were emitted for
-- ('scaffoldStructuralOwners') and nodes carry their own identity
-- ('nodeIdentity'), both of which the workspace's ownership index resolves to a
-- member file.
workspaceModules :: [GoldenPayload] -> Context -> WorkspaceSpec -> [(ScaffoldModule, ModuleProvenance)]
workspaceModules goldens ctx workspace =
[attributed (declarationProvenance names) m | (m, names) <- scaffoldStructuralOwners ctx merged]
<> [attributed ContextLevel m | m <- scaffoldReplayAudit ctx merged]
<> concat
[ map (attributed (nodeProvenance node)) (emittersFor node)
| node <- specNodes merged
]
where
merged = wsMergedSpec workspace
ownership = wsOwnership workspace
emittersFor node = case node of
NAggregate aggregate -> scaffoldAggregate ctx merged aggregate <> harnessForWithGoldens goldens ctx merged aggregate
NProcess process -> scaffoldProcess ctx process <> harnessProcess ctx process
NRouter router -> scaffoldRouter ctx router <> harnessRouter ctx router
NContract contract -> scaffoldContract ctx contract
NIntake intake -> scaffoldIntake ctx intake
NPublisher publisher -> scaffoldPublisher ctx publisher
NWorkqueue workqueue -> scaffoldWorkqueue ctx workqueue
NReadModel readModel -> scaffoldReadModel ctx readModel <> harnessReadModel ctx readModel
NWorkflow workflow -> harnessWorkflow ctx workflow
NEmit _ -> []
NPgmqDispatch _ -> []
NOperation _ -> []
nodeProvenance node =
let (kind', name, _) = nodeIdentity node
in maybe ContextLevel (MemberOwned . fst) (nodeOwner ownership kind' name)
-- A structural module belongs to a member only when every declaration it
-- was emitted for has the same owner. A binding skeleton shared by
-- declarations from two members belongs to neither: attributing it to one
-- would make the other member's obligations look like they moved whenever
-- the map iteration order changed.
declarationProvenance names = case nub owners of
[owner] | length owners == length names -> MemberOwned owner
_ -> ContextLevel
where
owners = [owner | name <- names, Just (owner, _) <- [declarationOwner ownership "mapped" name]]
-- Name the producing member in refusal messages, so a cross-member path
-- collision says which files claimed the path. `origin` is metadata read
-- only by refusal rendering: it never reaches the module text, the record,
-- or the build manifest. A single-member workspace adds no prefix, which is
-- what keeps it identical to the single-file path down to this field.
attributed provenance m = (annotate provenance m, provenance)
annotate (MemberOwned path) m
| length (wsMembers workspace) > 1 = m {origin = T.pack path <> ": " <> origin m}
annotate _ m = m
--------------------------------------------------------------------------------
-- Golden payload roots
--------------------------------------------------------------------------------
-- | Refuse when a member has golden payload fixtures beside it that the
-- workspace's single golden root does not have.
--
-- Golden fixtures are keyed @\<context\>\/\<Aggregate\>\/\<Event\>.v\<N\>.json@ —
-- by aggregate, and an aggregate has exactly one owner across a workspace — so one
-- root per workspace cannot collide, while a per-member root would make a
-- fixture's location depend on which file currently owns the aggregate and break
-- the rule that an ownership move is not a content change.
--
-- Without this check the failure would be silent: a member-adjacent fixture the
-- workspace root lacks is simply not found, the harness embeds a synthesized weak
-- stand-in instead of the file-owned payload, and generated bytes change with no
-- diagnostic at all.
goldenRootDivergence :: FilePath -> WorkspaceSpec -> IO [Refusal]
goldenRootDivergence workspaceRoot workspace = do
stranded <- concat <$> traverse strandedFor (wsMembers workspace)
pure [GoldenRootDivergence workspaceRoot stranded | not (null stranded)]
where
manifestDir = takeDirectory (wsManifestPath workspace)
strandedFor member = concat <$> traverse (check member) (upcastFixtures (wmSpec member))
check member relative = do
let memberRoot = manifestDir </> takeDirectory (wmPath member) </> "golden-payloads"
besideMember <- firstExisting memberRoot relative
case besideMember of
Nothing -> pure []
Just found -> do
atRoot <- firstExisting workspaceRoot relative
pure (case atRoot of Nothing -> [found]; Just _ -> [])
-- Mirror the two shapes `loadGoldenPayloads` accepts: a root holding
-- context directories, or a root that already is the context directory.
firstExisting root relative = firstJustM [root </> relative, root </> dropContext relative]
dropContext relative = case break (== '/') relative of
(_, '/' : rest) -> rest
_ -> relative
firstJustM [] = pure Nothing
firstJustM (path : rest) = do
exists <- doesFileExist path
if exists then pure (Just path) else firstJustM rest
-- | The @\<context\>\/\<Aggregate\>\/\<Event\>.v\<N\>.json@ fixture paths a
-- spec's declared upcasters would load, in spec order.
upcastFixtures :: Spec -> [FilePath]
upcastFixtures spec =
[ T.unpack (specContext spec) </> T.unpack (aggName aggregate) </> fixtureName event sourceVersion
| NAggregate aggregate <- specNodes spec,
event <- aggEvents aggregate,
Just (sourceVersion, _) <- [evUpcastFrom event]
]
where
fixtureName event sourceVersion = T.unpack (evName event) <> ".v" <> show sourceVersion <> ".json"
--------------------------------------------------------------------------------
-- Execution
--------------------------------------------------------------------------------
-- | A module the workspace still produces, but from a different member file
-- than last time. 'Nothing' on either side means context-level.
--
-- An ownership move is deliberately __not__ a stale entry and __not__ a new file:
-- the path is still produced, so nothing is orphaned. Reporting it separately is
-- what stops "I moved this aggregate to another file" from looking like "another
-- spec's leftovers". Whole-workspace diffing must classify it identically.
data OwnershipMove = OwnershipMove
{ omPath :: !FilePath,
omPrevious :: !(Maybe FilePath),
omCurrent :: !(Maybe FilePath)
}
deriving stock (Eq, Show)
data WorkspaceSourceLanguageDrift = WorkspaceSourceLanguageDrift
{ wsldPath :: !FilePath,
wsldPrevious :: !SourceLanguage,
wsldCurrent :: !SourceLanguage
}
deriving stock (Eq, Show)
-- | What one successful whole-workspace scaffold did.
data WorkspaceScaffoldReport = WorkspaceScaffoldReport
{ wsrManifestPath :: !FilePath,
wsrOutDir :: !FilePath,
wsrService :: !Text,
wsrContext :: !Context,
wsrMembers :: ![FilePath],
wsrDispositions :: ![(ScaffoldModule, ModuleProvenance, WriteDisposition)],
wsrBuildManifestPath :: !FilePath,
wsrRecordPath :: !FilePath,
-- | The manifest file name the previous workspace record was written from,
-- when it differs from this run's.
wsrPreviousManifest :: !(Maybe Text),
wsrStale :: ![StaleModule],
wsrOwnershipMoves :: ![OwnershipMove],
wsrConsumerPlan :: !ConsumerPlan,
wsrConstraintPlan :: ![Text],
wsrMappingDrift :: ![MappingDrift],
wsrSourceLanguageDrift :: ![WorkspaceSourceLanguageDrift],
wsrNewHoles :: ![BindingHole],
-- | Present only on the run that adopted pre-workspace scaffold output.
wsrMigration :: !(Maybe MigrationReport)
}
deriving stock (Eq, Show)
-- | Execute a planned whole-workspace scaffold.
--
-- The shape mirrors 'Keiro.Dsl.ScaffoldRun.executeScaffold' step for step, with
-- three differences that matter:
--
-- * Both preflights — stranded golden fixtures and Generated paths lacking the
-- @-- \@generated@ banner — are evaluated over the __complete__ workspace set
-- before the output directory is created or any file is touched. A bannerless
-- file under any member's subtree therefore refuses the whole run, and a
-- refused run leaves the tree, the record, and the build manifest untouched.
--
-- * History is read from and written to the workspace-keyed record, so stale
-- detection compares whole workspaces. A module produced by a sibling member
-- is in the current set and can no longer be a false positive — the defect
-- that made two same-context specs report each other's files as stale.
--
-- * A Generated module whose bytes already match is reported 'Unchanged' and
-- not rewritten, which is what makes idempotence observable rather than
-- merely claimed.
executeWorkspaceScaffold :: FilePath -> Bool -> WorkspacePlan -> IO (Either [Refusal] WorkspaceScaffoldReport)
executeWorkspaceScaffold out forceGeneratedOverwrite plan = do
stranded <- goldenRootDivergence (wpGoldenRoot plan) workspace
bannerless <- if forceGeneratedOverwrite then pure [] else missingGeneratedBanners out modules
case stranded <> [MissingGeneratedBanner bannerless | not (null bannerless)] of
refusals@(_ : _) -> pure (Left refusals)
[] -> do
previous <- readWorkspaceRecord recordPath
stale <- staleAgainst out (map modulePath modules) (previousFiles previous)
-- Adoption is a one-shot, guarded by the absence of workspace
-- history: once this workspace owns the directory there is nothing
-- left to import, and the migration report stays as written.
migration <- case previous of
Just _ -> pure Nothing
Nothing -> adoptionReport out (wsContext workspace) service modules
let currentPlan = consumerPlan merged
drift = maybe [] (mappingDrift (consumerMappings currentPlan) . wrMappings) previous
languageDrift = workspaceSourceLanguageDrift workspace previous
currentObligations = either (const []) id (bindingHoles merged)
newHoles = maybe [] (newBindingObligations currentObligations . wrBindingObligations) previous
createDirectoryIfMissing True out
dispositions <- traverse (writeWorkspaceModule out) (wpModules plan)
TIO.writeFile buildManifestPath (renderManifest (T.pack manifestName) modules merged)
-- Adoption provenance is durable history, not a one-run note: a
-- later run that adopts nothing carries the previous rows forward,
-- or the record would silently forget where its files came from.
let adopted = case migration of
Just report -> adoptedRows report
Nothing -> maybe [] wrAdopted previous
TIO.writeFile recordPath (renderWorkspaceRecord (currentWorkspaceRecord plan adopted))
case migration of
Nothing -> pure ()
Just report -> do
TIO.writeFile
(out </> workspaceMigrationReportFileName service)
(T.unlines (renderMigrationReport report))
markLegacyRecordSuperseded out (wsContext workspace) service
pure $
Right
WorkspaceScaffoldReport
{ wsrManifestPath = wsManifestPath workspace,
wsrOutDir = out,
wsrService = wsService workspace,
wsrContext = wpContext plan,
wsrMembers = map wmPath (wsMembers workspace),
wsrDispositions = dispositions,
wsrBuildManifestPath = buildManifestPath,
wsrRecordPath = recordPath,
wsrPreviousManifest = do
record <- previous
if wrManifest record == T.pack manifestName then Nothing else Just (wrManifest record),
wsrStale = stale,
wsrOwnershipMoves = ownershipMoves previous (wpModules plan),
wsrConsumerPlan = currentPlan,
wsrConstraintPlan = constraintPlan merged currentPlan,
wsrMappingDrift = drift,
wsrSourceLanguageDrift = languageDrift,
wsrNewHoles = newHoles,
wsrMigration = migration
}
where
workspace = wpWorkspace plan
merged = wsMergedSpec workspace
modules = map fst (wpModules plan)
service = wsService workspace
manifestName = takeFileName (wsManifestPath workspace)
recordPath = out </> workspaceRecordFileName service
buildManifestPath = out </> workspaceManifestFileName service
previousFiles previous = [(wrmKind row, wrmPath row) | row <- maybe [] wrModules previous]
readWorkspaceRecord :: FilePath -> IO (Maybe WorkspaceRecord)
readWorkspaceRecord path = do
exists <- doesFileExist path
if exists then parseWorkspaceRecord <$> TIO.readFile path else pure Nothing
-- | The record this run writes: the plan's modules with their owners, the
-- canonical member list, the merged graph's mappings and obligations, and any
-- files adopted from pre-workspace scaffold output.
currentWorkspaceRecord :: WorkspacePlan -> [AdoptedRow] -> WorkspaceRecord
currentWorkspaceRecord plan adopted =
WorkspaceRecord
{ wrService = wsService workspace,
wrManifest = T.pack (takeFileName (wsManifestPath workspace)),
wrContext = wsContext workspace,
wrModuleRoot = moduleRoot ctx,
wrLayout = layoutLabel ctx,
wrMembers = map wmPath (wsMembers workspace),
wrSourceLanguages =
[ WorkspaceSourceLanguageRow (wmPath member) (wmSourceLanguage member)
| member <- wsMembers workspace
],
wrModules =
[ WorkspaceModuleRow
{ wrmKind = kind m,
wrmPath = modulePath m,
wrmOwner = provenanceOwner provenance
}
| (m, provenance) <- wpModules plan
],
wrMappings = consumerMappings (consumerPlan merged),
wrBindingObligations = either (const []) id (bindingHoles merged),
wrAdopted = adopted
}
where
workspace = wpWorkspace plan
merged = wsMergedSpec workspace
ctx = wpContext plan
workspaceSourceLanguageDrift :: WorkspaceSpec -> Maybe WorkspaceRecord -> [WorkspaceSourceLanguageDrift]
workspaceSourceLanguageDrift workspace previous =
[ WorkspaceSourceLanguageDrift path oldLanguage newLanguage
| member <- wsMembers workspace,
let path = wmPath member
newLanguage = wmSourceLanguage member,
Just oldLanguage <- [Map.lookup path previousByPath],
oldLanguage /= newLanguage
]
where
previousByPath =
Map.fromList
[ (wrslPath row, wrslSourceLanguage row)
| row <- maybe [] wrSourceLanguages previous
]
layoutLabel :: Context -> Text
layoutLabel ctx = case placement ctx of GeneratedPrefix -> "prefixed"; CollocatedLeaf -> "collocated"
-- | Paths this run still produces whose owning member changed. Computed against
-- the previous record before stale detection, and never overlapping it: a moved
-- module's path is still in the current plan, so it was never a removal.
ownershipMoves :: Maybe WorkspaceRecord -> [(ScaffoldModule, ModuleProvenance)] -> [OwnershipMove]
ownershipMoves previous current =
[ OwnershipMove
{ omPath = modulePath m,
omPrevious = wrmOwner row,
omCurrent = provenanceOwner provenance
}
| (m, provenance) <- current,
Just row <- [Map.lookup (modulePath m) previousByPath],
wrmOwner row /= provenanceOwner provenance
]
where
previousByPath = Map.fromList [(wrmPath row, row) | row <- maybe [] wrModules previous]
-- | Write one module. Generated modules whose bytes already match are left
-- alone and reported 'Unchanged'; hole modules keep the create-once rule. The
-- single-spec 'Keiro.Dsl.ScaffoldRun.executeScaffold' is untouched, so its report
-- bytes are unaffected.
writeWorkspaceModule ::
FilePath ->
(ScaffoldModule, ModuleProvenance) ->
IO (ScaffoldModule, ModuleProvenance, WriteDisposition)
writeWorkspaceModule out (m, provenance) = do
let path = out </> modulePath m
exists <- doesFileExist path
case kind m of
HoleStub
| exists -> pure (m, provenance, Skipped)
| otherwise -> write path Created
Generated
| exists -> do
existing <- TIO.readFile path
if existing == moduleText m
then pure (m, provenance, Unchanged)
else write path Overwritten
| otherwise -> write path Overwritten
where
write path disposition = do
createDirectoryIfMissing True (takeDirectory path)
TIO.writeFile path (moduleText m)
pure (m, provenance, disposition)
-- | The report a successful whole-workspace scaffold prints, following the
-- single-spec report's shape so the two stay readable side by side: the header
-- names the service instead of a spec, each module line carries its owning member,
-- and the stale section keeps the exact "keiro-dsl never deletes files." sentence.
renderWorkspaceScaffoldReport :: WorkspaceScaffoldReport -> [Text]
renderWorkspaceScaffoldReport report =
[ "workspace: "
<> wsrService report
<> " ("
<> T.pack (wsrManifestPath report)
<> ") -> "
<> T.pack (wsrOutDir report)
<> " (module-root="
<> rootLabel
<> ", layout="
<> layoutLabel ctx
<> ")",
"members: " <> T.intercalate ", " (map T.pack (wsrMembers report))
]
<> map moduleLine dispositions
<> [ "firewall: OK (" <> tshow generatedCount <> " generated modules scanned, 0 forbidden operators)",
harnessLine,
dependencyLine,
"manifest: " <> T.pack (wsrBuildManifestPath report),
"record: " <> T.pack (wsrRecordPath report)
]
<> previousManifestNote
<> migrationSection
<> constraintSection
<> newHolesSection
<> mappingDriftSection
<> sourceLanguageDriftSection
<> ownershipSection
<> staleSection
where
ctx = wsrContext report
dispositions = wsrDispositions report
rootLabel = if T.null (moduleRoot ctx) then "(none)" else moduleRoot ctx
names = [moduleNameOf (modulePath m) | (m, _, _) <- dispositions]
nameWidth = maximum (1 : map T.length names)
moduleLine (m, provenance, disposition) =
" "
<> kindTag (kind m)
<> " "
<> pad (moduleNameOf (modulePath m))
<> " "
<> dispositionTag disposition
<> " "
<> ownerTag provenance
kindTag Generated = "generated"
kindTag HoleStub = "hole "
dispositionTag Overwritten = "(overwritten)"
dispositionTag Created = "(created)"
dispositionTag Skipped = "(skipped: already present)"
dispositionTag Unchanged = "(unchanged)"
ownerTag ContextLevel = "(context-level)"
ownerTag (MemberOwned path) = T.pack path
pad name = name <> T.replicate (nameWidth - T.length name) " "
generatedCount = length [() | (m, _, _) <- dispositions, kind m == Generated]
harnesses =
sortOn
id
[ moduleNameOf (modulePath m)
| (m, _, _) <- dispositions,
any (`T.isSuffixOf` moduleNameOf (modulePath m)) [".Harness", ".ProcessHarness", ".WorkflowFacts"]
]
harnessLine = case harnesses of
[] -> "harness: (none emitted)"
_ -> "harness: run `cabal test <your-component>` over " <> T.unwords harnesses
dependencyLine =
"dependency plan: consumer packages "
<> renderBracketed (consumerPackages (wsrConsumerPlan report))
<> ", consumer modules "
<> renderBracketed (consumerModules (wsrConsumerPlan report))
previousManifestNote = case wsrPreviousManifest report of
Just previous -> ["note: the previous workspace record was written from manifest " <> previous]
Nothing -> []
migrationSection = maybe [] renderMigrationReport (wsrMigration report)
constraintSection = case wsrConstraintPlan report of
[] -> []
constraints -> "constraint plan:" : map (" " <>) constraints
newHolesSection = case wsrNewHoles report of
[] -> []
obligations ->
["newly required holes since last scaffold: " <> tshow (length obligations)]
<> concatMap obligationLines obligations
obligationLines hole =
[ " " <> holeModule hole,
" " <> holeSignature hole <> " (" <> obligationKindLabel (holeKind hole) <> ")"
]
mappingDriftSection = case wsrMappingDrift report of
[] -> []
drifts ->
["mapping drift: " <> tshow (length drifts) <> " declaration(s) changed since the previous scaffold:"]
<> concatMap driftLines drifts
driftLines drift =
[ " " <> driftSpecName drift,
" previous: " <> maybe "(absent)" renderMappingIdentity (driftPrevious drift),
" current: " <> maybe "(absent)" renderMappingIdentity (driftCurrent drift)
]
sourceLanguageDriftSection = case wsrSourceLanguageDrift report of
[] -> []
drifts ->
["source-language drift: " <> tshow (length drifts) <> " member(s) changed provenance (generated module bytes are semantic and unaffected):"]
<> [ " "
<> T.pack (wsldPath drift)
<> " "
<> sourceFormText (wsldPrevious drift)
<> " -> "
<> sourceFormText (wsldCurrent drift)
| drift <- drifts
]
ownershipSection = case wsrOwnershipMoves report of
[] -> []
moves ->
["ownership moves: " <> tshow (length moves) <> " module(s) changed owning member (content unaffected):"]
<> [ " " <> T.pack (omPath move) <> " " <> ownerName (omPrevious move) <> " -> " <> ownerName (omCurrent move)
| move <- moves
]
ownerName = maybe "(context-level)" T.pack
staleSection = case wsrStale report of
[] -> []
stale ->
[ "stale: "
<> tshow (length stale)
<> " file(s) from a previous scaffold of workspace "
<> wsrService report
<> " are no longer produced by this workspace:"
]
<> map staleLine stale
<> ["note: keiro-dsl never deletes files."]
staleLine stale = case staleKind stale of
Generated -> " generated " <> T.pack (stalePath stale) <> " (safe to delete; still on disk)"
HoleStub -> " hole " <> T.pack (stalePath stale) <> " (hand-owned — review before deleting)"
renderBracketed :: [Text] -> Text
renderBracketed values = "[" <> T.intercalate ", " values <> "]"
tshow :: (Show a) => a -> Text
tshow = T.pack . show