seihou-core 0.4.0.0 → 0.5.0.0

raw patch · 47 files changed

+4112/−180 lines, 47 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• seihou-core.cabal +18/−1
• src/Seihou/Composition/Resolve.hs +59/−5
• src/Seihou/Core/Application.hs +102/−0
• src/Seihou/Core/Blueprint.hs +47/−0
• src/Seihou/Core/CommandFingerprint.hs +23/−0
• src/Seihou/Core/Migration.hs +87/−36
• src/Seihou/Core/Scaffold.hs +1/−0
• src/Seihou/Core/Types.hs +88/−5
• src/Seihou/Core/Variable.hs +55/−21
• src/Seihou/Dhall/Eval.hs +27/−14
• src/Seihou/Effect/BaselineStore.hs +38/−0
• src/Seihou/Effect/BaselineStoreInterp.hs +84/−0
• src/Seihou/Effect/BaselineStorePure.hs +46/−0
• src/Seihou/Engine/Baseline.hs +54/−0
• src/Seihou/Engine/Execute.hs +11/−5
• src/Seihou/Engine/Plan.hs +29/−19
• src/Seihou/Engine/Preview.hs +23/−10
• src/Seihou/Engine/Reconcile.hs +594/−0
• src/Seihou/Engine/ThreeWayMerge.hs +90/−0
• src/Seihou/Engine/UpdateTransaction.hs +602/−0
• src/Seihou/Manifest/Hash.hs +18/−1
• src/Seihou/Manifest/Types.hs +206/−8
• test/Main.hs +15/−1
• test/Seihou/Composition/PlanSpec.hs +2/−2
• test/Seihou/Composition/ResolveSpec.hs +54/−0
• test/Seihou/Core/ApplicationSpec.hs +160/−0
• test/Seihou/Core/BlueprintSpec.hs +69/−10
• test/Seihou/Core/CommandFingerprintSpec.hs +41/−0
• test/Seihou/Core/MigrationSpec.hs +45/−1
• test/Seihou/Core/ScaffoldSpec.hs +2/−0
• test/Seihou/Core/StatusSpec.hs +3/−1
• test/Seihou/Core/TypesSpec.hs +1/−1
• test/Seihou/Effect/BaselineStoreSpec.hs +104/−0
• test/Seihou/Effect/ManifestStoreSpec.hs +2/−2
• test/Seihou/Engine/BaselineSpec.hs +103/−0
• test/Seihou/Engine/DiffSpec.hs +20/−6
• test/Seihou/Engine/ExecuteSpec.hs +2/−2
• test/Seihou/Engine/MigrateSpec.hs +3/−1
• test/Seihou/Engine/PlanSpec.hs +37/−7
• test/Seihou/Engine/PreviewSpec.hs +18/−3
• test/Seihou/Engine/ReconcileSpec.hs +330/−0
• test/Seihou/Engine/RemoveSpec.hs +19/−6
• test/Seihou/Engine/ThreeWayMergeSpec.hs +118/−0
• test/Seihou/Engine/UpdateTransactionSpec.hs +453/−0
• test/Seihou/Integration/ExecutionSpec.hs +5/−1
• test/Seihou/Interaction/PromptSpec.hs +18/−1
• test/Seihou/Manifest/TypesSpec.hs +186/−10

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-core-version: 0.4.0.0+version: 0.5.0.0 synopsis: Core library for Seihou project scaffolding description:   Core library for Seihou, a composable project scaffolding system.@@ -39,7 +39,9 @@     Seihou.Composition.Recipe     Seihou.Composition.Resolve     Seihou.Core.AgentPrompt+    Seihou.Core.Application     Seihou.Core.Blueprint+    Seihou.Core.CommandFingerprint     Seihou.Core.CommandVar     Seihou.Core.Context     Seihou.Core.Expr@@ -57,6 +59,9 @@     Seihou.Core.Version     Seihou.Dhall.Config     Seihou.Dhall.Eval+    Seihou.Effect.BaselineStore+    Seihou.Effect.BaselineStoreInterp+    Seihou.Effect.BaselineStorePure     Seihou.Effect.ConfigReader     Seihou.Effect.ConfigReaderInterp     Seihou.Effect.ConfigReaderPure@@ -80,6 +85,7 @@     Seihou.Effect.Process     Seihou.Effect.ProcessInterp     Seihou.Effect.ProcessPure+    Seihou.Engine.Baseline     Seihou.Engine.Conflict     Seihou.Engine.DhallJSON     Seihou.Engine.Diff@@ -87,10 +93,13 @@     Seihou.Engine.Migrate     Seihou.Engine.Plan     Seihou.Engine.Preview+    Seihou.Engine.Reconcile     Seihou.Engine.Remove     Seihou.Engine.Section     Seihou.Engine.Template+    Seihou.Engine.ThreeWayMerge     Seihou.Engine.TypedDhallText+    Seihou.Engine.UpdateTransaction     Seihou.Engine.Validate     Seihou.Interaction.Confirm     Seihou.Interaction.Prompt@@ -114,6 +123,7 @@     generic-lens >=2.2 && <3,     lens >=5.2 && <6,     process >=1.6 && <2,+    temporary >=1.3 && <2,     text >=2.0 && <3,     time >=1.12 && <2,     transformers >=0.6 && <1,@@ -138,7 +148,9 @@     Seihou.Composition.RecipeSpec     Seihou.Composition.ResolveSpec     Seihou.Core.AgentPromptSpec+    Seihou.Core.ApplicationSpec     Seihou.Core.BlueprintSpec+    Seihou.Core.CommandFingerprintSpec     Seihou.Core.CommandVarSpec     Seihou.Core.ContextSpec     Seihou.Core.ExprSpec@@ -159,20 +171,25 @@     Seihou.Dhall.ConfigSpec     Seihou.Dhall.EvalSpec     Seihou.Dhall.MigrationDecoderSpec+    Seihou.Effect.BaselineStoreSpec     Seihou.Effect.ConfigReaderSpec     Seihou.Effect.ConfigWriterSpec     Seihou.Effect.FilesystemSpec     Seihou.Effect.LoggerSpec     Seihou.Effect.ManifestStoreSpec+    Seihou.Engine.BaselineSpec     Seihou.Engine.ConflictSpec     Seihou.Engine.DiffSpec     Seihou.Engine.ExecuteSpec     Seihou.Engine.MigrateSpec     Seihou.Engine.PlanSpec     Seihou.Engine.PreviewSpec+    Seihou.Engine.ReconcileSpec     Seihou.Engine.RemoveSpec     Seihou.Engine.SectionSpec     Seihou.Engine.TemplateSpec+    Seihou.Engine.ThreeWayMergeSpec+    Seihou.Engine.UpdateTransactionSpec     Seihou.Engine.ValidateSpec     Seihou.Evaluation.ConditionalTemplateSpec     Seihou.Evaluation.DhallTextFlakeSpec

@@ -1,7 +1,11 @@ module Seihou.Composition.Resolve   ( loadComposition,+    SavedInstanceValues,+    PromptPermission (..),     resolveComposedVariables,+    resolveComposedVariablesWithSaved,     resolveWithPrompts,+    resolveWithPromptPermission,     exportedVars,     collectParentVars,   )@@ -15,12 +19,21 @@ import Seihou.Composition.Instance (ModuleInstance (..), mkInstance, primaryInstance) import Seihou.Core.Module (discoverModule, validateModule) import Seihou.Core.Types-import Seihou.Core.Variable (resolveVariables)+import Seihou.Core.Variable (resolveVariablesWithSaved) import Seihou.Dhall.Eval (evalModuleFromFile) import Seihou.Effect.Console (Console, isInteractive, putText) import Seihou.Interaction.Prompt (runPrompts) import Seihou.Prelude +-- | Values captured by a previously accepted composition, kept distinct per+-- parameterized module instance.+type SavedInstanceValues = Map ModuleInstance (Map VarName Text)++-- | Whether resolution may consult the Console prompt layer. Even when+-- allowed, prompts are used only for an interactive Console interpreter.+data PromptPermission = PromptsAllowed | PromptsForbidden+  deriving stock (Eq, Show)+ -- | Load all modules in a composition: primary + additional + transitive deps. -- Additional modules are treated as implicit dependencies of the primary module. -- Returns modules with their directories in execution order (dependencies first).@@ -69,6 +82,23 @@   Map VarName Text ->   Either [VarError] (Map ModuleInstance (Map VarName ResolvedVar)) resolveComposedVariables modulesInOrder cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig =+  resolveComposedVariablesWithSaved modulesInOrder Map.empty cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig++-- | Resolve a composition while replaying values saved for matching module+-- instances. Candidate declarations still own coercion and validation.+resolveComposedVariablesWithSaved ::+  [(ModuleInstance, Module, FilePath)] ->+  SavedInstanceValues ->+  Map VarName Text ->+  Map Text Text ->+  Text ->+  Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Either [VarError] (Map ModuleInstance (Map VarName ResolvedVar))+resolveComposedVariablesWithSaved modulesInOrder savedValues cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig =   let allParentVars = collectParentVars modulesInOrder    in go allParentVars modulesInOrder Map.empty Map.empty   where@@ -83,7 +113,8 @@       let visibleExports = gatherEdgeExports m allExports           adjustedDecls = map (injectExportDefault visibleExports) m.vars           myParentVars = Map.findWithDefault Map.empty inst parentVarsMap-      resolved <- resolveVariables adjustedDecls cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars+          saved = Map.findWithDefault Map.empty inst savedValues+      resolved <- resolveVariablesWithSaved adjustedDecls cliOverrides saved envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars       let declaredNames = Set.fromList (map (.name) m.vars)           inherited =             Map.mapWithKey@@ -115,7 +146,29 @@   Map VarName Text ->   Eff es (Either [VarError] (Map ModuleInstance (Map VarName ResolvedVar))) resolveWithPrompts modulesInOrder cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig = do-  interactive <- isInteractive+  resolveWithPromptPermission PromptsAllowed modulesInOrder Map.empty cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig++-- | Prompt-aware resolver with explicit permission and saved application+-- values. 'PromptsForbidden' never asks the Console interpreter whether a TTY+-- is present and therefore remains deterministic in JSON/non-TTY callers.+resolveWithPromptPermission ::+  (Console :> es) =>+  PromptPermission ->+  [(ModuleInstance, Module, FilePath)] ->+  SavedInstanceValues ->+  Map VarName Text ->+  Map Text Text ->+  Text ->+  Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Eff es (Either [VarError] (Map ModuleInstance (Map VarName ResolvedVar)))+resolveWithPromptPermission permission modulesInOrder savedValues cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig = do+  interactive <- case permission of+    PromptsAllowed -> isInteractive+    PromptsForbidden -> pure False   let allParentVars = collectParentVars modulesInOrder   goPrompt interactive allParentVars modulesInOrder Map.empty Map.empty   where@@ -132,7 +185,8 @@       let visibleExports = gatherEdgeExports m allExports           adjustedDecls = map (injectExportDefault visibleExports) m.vars           myParentVars = Map.findWithDefault Map.empty inst parentVarsMap-      case resolveVariables adjustedDecls cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars of+          saved = Map.findWithDefault Map.empty inst savedValues+      case resolveVariablesWithSaved adjustedDecls cliOverrides saved envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars of         Right resolved -> do           let declaredNames = Set.fromList (map (.name) m.vars)               inherited =@@ -182,7 +236,7 @@                       let promptedOverrides =                             Map.union cliOverrides $                               Map.map (varValueToText . (.value)) prompted-                      case resolveVariables adjustedDecls promptedOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars of+                      case resolveVariablesWithSaved adjustedDecls promptedOverrides saved envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars of                         Left errs' -> pure (Left errs')                         Right resolved -> do                           let resolvedWithPromptSource =

@@ -0,0 +1,102 @@+module Seihou.Core.Application+  ( mkApplicationId,+    buildAppliedComposition,+    replaceAppliedComposition,+    attachApplication,+  )+where++import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime)+import Seihou.Composition.Instance (ModuleInstance (..))+import Seihou.Core.Types+import Seihou.Manifest.Hash (hashContent)++-- | Derive the stable identity of a top-level application. Versions,+-- source paths, and resolved values are deliberately excluded so a later+-- update replaces the same application record.+mkApplicationId :: AppliedTarget -> [ModuleName] -> ApplicationId+mkApplicationId target additional =+  ApplicationId (hashContent canonical).unSHA256+  where+    (kind, targetName) = case target of+      AppliedModuleTarget name -> ("module", name.unModuleName)+      AppliedRecipeTarget name -> ("recipe", name.unRecipeName)+    canonical =+      T.intercalate+        "\n"+        ( [ "target-kind=" <> kind,+            "target-name=" <> targetName+          ]+            ++ map ("additional=" <>) (map (.unModuleName) additional)+        )++-- | Capture a composition using the already-resolved, instance-scoped+-- values from the generation pipeline.+buildAppliedComposition ::+  AppliedTarget ->+  FilePath ->+  Maybe Text ->+  [ModuleName] ->+  Maybe Text ->+  Maybe Text ->+  [(ModuleInstance, Module, FilePath)] ->+  Map ModuleInstance (Map VarName ResolvedVar) ->+  UTCTime ->+  AppliedComposition+buildAppliedComposition target targetSource targetVersion additional namespace context modulesInOrder resolved now =+  AppliedComposition+    { applicationId = mkApplicationId target additional,+      target = target,+      targetSource = targetSource,+      targetVersion = targetVersion,+      additionalModules = additional,+      namespace = namespace,+      context = context,+      instances = map buildInstance modulesInOrder,+      commandReceipts = Map.empty,+      appliedAt = now+    }+  where+    buildInstance (inst, modul, source) =+      AppliedInstanceState+        { name = inst.instanceModule,+          parentVars = inst.instanceParentVars,+          source = source,+          moduleVersion = modul.version,+          resolvedVars = Map.map (varValueToText . (.value)) (Map.findWithDefault Map.empty inst resolved)+        }++-- | Replace an existing application in place, or append a newly-applied one.+replaceAppliedComposition :: AppliedComposition -> [AppliedComposition] -> [AppliedComposition]+replaceAppliedComposition replacement existing+  | any ((== replacement.applicationId) . (.applicationId)) existing =+      map replaceMatching existing+  | otherwise = existing ++ [replacement]+  where+    replaceMatching current+      | current.applicationId == replacement.applicationId = replacement+      | otherwise = current++-- | Attribute the current file result to an application while retaining+-- ownership from the prior record and any ownership already on the result.+-- The current record's baseline is preserved: EP-65 captures the exact+-- post-execution generated content before ownership is attached.+attachApplication :: ApplicationId -> Maybe FileRecord -> FileRecord -> FileRecord+attachApplication applicationId previous current =+  current+    { applicationIds = Set.insert applicationId (Set.union current.applicationIds priorApplications)+    }+  where+    priorApplications = maybe Set.empty (.applicationIds) previous++varValueToText :: VarValue -> Text+varValueToText (VText value) = value+varValueToText (VBool True) = "true"+varValueToText (VBool False) = "false"+varValueToText (VInt value) = T.pack (show value)+varValueToText (VList values) = T.intercalate "," (map varValueToText values)

@@ -11,14 +11,17 @@     checkBlueprintFiles,     checkBlueprintTags,     checkBlueprintAllowedTools,+    checkBlueprintMigrations,   ) where  import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as T+import Seihou.Core.Migration (BlueprintMigration (..)) import Seihou.Core.Module (defaultSearchPaths, discoverRunnable, isValidModuleName) import Seihou.Core.Types+import Seihou.Core.Version (parseVersion) import Seihou.Prelude import System.Directory (doesFileExist) @@ -65,6 +68,7 @@           <> checkBlueprintPromptRefs b           <> checkBlueprintTags b           <> checkBlueprintAllowedTools b+          <> checkBlueprintMigrations b       allErrs = pureErrs <> fileErrs <> baseErrs   pure $     if null allErrs@@ -203,3 +207,46 @@     | t <- xs,       T.null (T.strip t)     ]++-- Rule 10: every migration is a forward dotted-numeric version edge with a+-- non-empty prompt, and each starting version occurs at most once.+checkBlueprintMigrations :: Blueprint -> [Text]+checkBlueprintMigrations b =+  concatMap checkOne b.migrations <> duplicateErrors+  where+    checkOne :: BlueprintMigration -> [Text]+    checkOne migration =+      promptErrors migration+        <> versionErrors "from" migration.from+        <> versionErrors "to" migration.to+        <> orderErrors migration++    promptErrors :: BlueprintMigration -> [Text]+    promptErrors migration =+      [ "blueprint migration "+          <> migration.from+          <> " -> "+          <> migration.to+          <> " prompt must not be empty"+      | T.null (T.strip migration.prompt)+      ]++    versionErrors label versionText = case parseVersion versionText of+      Nothing -> ["blueprint migration " <> label <> " version is not dotted numeric: " <> versionText]+      Just _ -> []++    orderErrors :: BlueprintMigration -> [Text]+    orderErrors migration = case (parseVersion migration.from, parseVersion migration.to) of+      (Just fromVersion, Just toVersion)+        | fromVersion >= toVersion ->+            [ "blueprint migration must advance versions: "+                <> migration.from+                <> " -> "+                <> migration.to+            ]+      _ -> []++    duplicateErrors =+      map+        ("duplicate blueprint migration from version: " <>)+        (findDupes Set.empty Set.empty (map (.from) b.migrations))

@@ -0,0 +1,23 @@+module Seihou.Core.CommandFingerprint+  ( fingerprintCommand,+  )+where++import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Manifest.Hash (hashContent)+import System.FilePath (normalise)++-- | Compute the stable identity of a rendered module command. Non-command+-- operations have no command fingerprint.+fingerprintCommand :: Operation -> Maybe CommandFingerprint+fingerprintCommand RunCommandOp {command, workDir, moduleName, occurrence} =+  Just . CommandFingerprint . hashContent $+    T.intercalate+      "\n"+      [ "module=" <> moduleName.unModuleName,+        "command=" <> command,+        "work-dir=" <> T.pack (normalise (maybe "." id workDir)),+        "occurrence=" <> T.pack (show occurrence)+      ]+fingerprintCommand _ = Nothing

@@ -2,11 +2,14 @@   ( -- * Author-declared migrations     Migration (..),     MigrationOp (..),+    BlueprintMigration (..),      -- * Migration planning     MigrationPlan (..),+    BlueprintMigrationPlan (..),     MigrationPlanError (..),     planMigrationChain,+    planBlueprintMigrationChain,   ) where @@ -47,6 +50,16 @@   }   deriving stock (Eq, Show, Generic) +-- | One agent-guided source migration declared by a blueprint. The+-- version strings use the same dotted-numeric format as module migrations,+-- while 'prompt' describes only the changes needed for this edge.+data BlueprintMigration = BlueprintMigration+  { from :: Text,+    to :: Text,+    prompt :: Text+  }+  deriving stock (Eq, Show, Generic)+ -- ---------------------------------------------------------------------------- -- Pure planner — gap-tolerant version-window walker --@@ -89,6 +102,17 @@   }   deriving stock (Eq, Show, Generic) +-- | The ordered blueprint migrations selected for a requested version+-- window. A non-trivial window may have no selected steps when the author+-- declared no agent intervention for that range.+data BlueprintMigrationPlan = BlueprintMigrationPlan+  { blueprintPlanName :: Text,+    blueprintPlanFrom :: Version,+    blueprintPlanTo :: Version,+    blueprintPlanSteps :: [BlueprintMigration]+  }+  deriving stock (Eq, Show, Generic)+ -- | All the ways planning can fail. Each carries enough information to -- write a useful error message at the CLI layer. data MigrationPlanError@@ -139,17 +163,10 @@   -- | Target version   Version ->   Either MigrationPlanError (Maybe MigrationPlan)-planMigrationChain modName migrations installed target-  | installed == target = Right Nothing-  | target < installed =-      Left (MigrationDowngradeNotSupported installed target)-  | otherwise = do-      parsed <- traverse parseEdges migrations-      checkDuplicates parsed-      let sorted = sortOn (\(_, f, _) -> f) parsed-          steps = pickInWindow installed target sorted-      Right-        ( Just+planMigrationChain modName migrations installed target =+  fmap+    ( fmap+        ( \steps ->             MigrationPlan               { planModule = modName,                 planFrom = installed,@@ -157,35 +174,69 @@                 planSteps = steps               }         )+    )+    (planMigrationWindow (.from) (.to) migrations installed target)++-- | Compute the ordered agent-guided migrations for a blueprint and version+-- window. Selection and errors deliberately match 'planMigrationChain'.+planBlueprintMigrationChain ::+  Text ->+  [BlueprintMigration] ->+  Version ->+  Version ->+  Either MigrationPlanError (Maybe BlueprintMigrationPlan)+planBlueprintMigrationChain blueprintName migrations current target =+  fmap+    ( fmap+        ( \steps ->+            BlueprintMigrationPlan+              { blueprintPlanName = blueprintName,+                blueprintPlanFrom = current,+                blueprintPlanTo = target,+                blueprintPlanSteps = steps+              }+        )+    )+    (planMigrationWindow (.from) (.to) migrations current target)++-- | Shared gap-tolerant version-window planner. Keeping parsing, duplicate+-- detection, ordering, overlap handling, and overshoot handling here prevents+-- module and blueprint migrations from developing subtly different rules.+planMigrationWindow ::+  (a -> Text) ->+  (a -> Text) ->+  [a] ->+  Version ->+  Version ->+  Either MigrationPlanError (Maybe [a])+planMigrationWindow getFrom getTo migrations current target+  | current == target = Right Nothing+  | target < current = Left (MigrationDowngradeNotSupported current target)+  | otherwise = do+      parsed <- traverse parseEdge migrations+      checkDuplicates parsed+      let sorted = sortOn (\(_, f, _) -> f) parsed+      Right (Just (pickInWindow current target sorted))   where-    -- Parse a migration's from/to fields into Version values.-    parseEdges m = do-      fv <- parseVersionE m.from-      tv <- parseVersionE m.to-      Right (m, fv, tv)+    parseEdge migration = do+      fromVersion <- parseVersionE (getFrom migration)+      toVersion <- parseVersionE (getTo migration)+      Right (migration, fromVersion, toVersion) -    parseVersionE t =-      case parseVersion t of-        Just v -> Right v-        Nothing -> Left (MigrationVersionUnparseable t)+    parseVersionE versionText =+      case parseVersion versionText of+        Just version -> Right version+        Nothing -> Left (MigrationVersionUnparseable versionText) -    -- Detect two migrations declaring the same `from` version.     checkDuplicates [] = Right ()-    checkDuplicates ((_, f, t) : rest) =-      case [t' | (_, f', t') <- rest, f' == f] of-        (t' : _) -> Left (MigrationDuplicateEdge f t')+    checkDuplicates ((_, fromVersion, _) : rest) =+      case [toVersion | (_, duplicateFrom, toVersion) <- rest, duplicateFrom == fromVersion] of+        (duplicateTo : _) -> Left (MigrationDuplicateEdge fromVersion duplicateTo)         [] -> checkDuplicates rest -    -- Walk the sorted edge list collecting in-window migrations.-    -- The list is sorted by `from` ascending, so once an edge has-    -- `from >= end` no later edge can contribute either. An edge with-    -- `from < cursor` is already-covered (or precedes the manifest)-    -- and is skipped. An edge with `to > end` overshoots the target-    -- and is silently skipped — a future invocation with a higher-    -- target will pick it up.     pickInWindow _cursor _end [] = []-    pickInWindow cursor end ((m, f, t) : rest)-      | f < cursor = pickInWindow cursor end rest-      | f >= end = []-      | t > end = pickInWindow cursor end rest-      | otherwise = m : pickInWindow t end rest+    pickInWindow cursor end ((migration, fromVersion, toVersion) : rest)+      | fromVersion < cursor = pickInWindow cursor end rest+      | fromVersion >= end = []+      | toVersion > end = pickInWindow cursor end rest+      | otherwise = migration : pickInWindow toVersion end rest

@@ -85,6 +85,7 @@       "      ]",       "    , baseModules = [] : List S.Dependency.Type",       "    , files = [] : List S.Blueprint.BlueprintFile.Type",+      "    , migrations = [] : List S.BlueprintMigration.Type",       "    , tags = [] : List Text",       "    }"     ]

@@ -35,9 +35,17 @@     Operation (..),     ModuleLoadError (..),     Manifest (..),+    ApplicationId (..),+    AppliedTarget (..),+    BaselineRef (..),+    CommandFingerprint (..),+    CommandReceipt (..),+    AppliedInstanceState (..),+    AppliedComposition (..),     AppliedModule (..),     AppliedRecipe (..),     AppliedBlueprint (..),+    AppliedBlueprintMigration (..),     FileRecord (..),     SHA256 (..),     DiffResult (..),@@ -60,12 +68,13 @@ where  import Data.Map.Strict (Map)+import Data.Set (Set) import Data.String (IsString) import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) import Numeric.Natural (Natural)-import Seihou.Core.Migration (Migration)+import Seihou.Core.Migration (BlueprintMigration, Migration)  -- | A module identifier such as @"haskell-base"@. newtype ModuleName = ModuleName {unModuleName :: Text}@@ -300,7 +309,8 @@     baseModules :: [Dependency],     files :: [BlueprintFile],     allowedTools :: Maybe [Text],-    tags :: [Text]+    tags :: [Text],+    migrations :: [BlueprintMigration]   }   deriving stock (Eq, Show, Generic) @@ -383,7 +393,9 @@       }   | RunCommandOp       { command :: Text,-        workDir :: Maybe FilePath+        workDir :: Maybe FilePath,+        moduleName :: ModuleName,+        occurrence :: Int       }   | PatchFileOp       { dest :: FilePath,@@ -408,6 +420,7 @@ -- | Tracks where a variable's value came from (for provenance / @--explain@). data VarSource   = FromCLI+  | FromApplication   | FromEnv Text   | FromLocalConfig   | FromNamespaceConfig Text@@ -457,11 +470,66 @@     modules :: [AppliedModule],     vars :: Map VarName Text,     files :: Map FilePath FileRecord,+    applications :: [AppliedComposition],     recipe :: Maybe AppliedRecipe,-    blueprint :: Maybe AppliedBlueprint+    blueprint :: Maybe AppliedBlueprint,+    blueprintMigrations :: [AppliedBlueprintMigration]   }   deriving stock (Eq, Show, Generic) +-- | Stable identity for one top-level module or recipe application.+newtype ApplicationId = ApplicationId {unApplicationId :: Text}+  deriving stock (Eq, Ord, Show, Generic)++-- | The deterministic artifact originally requested by the user.+data AppliedTarget+  = AppliedModuleTarget ModuleName+  | AppliedRecipeTarget RecipeName+  deriving stock (Eq, Ord, Show, Generic)++-- | Content-addressed reference to generated baseline bytes.+newtype BaselineRef = BaselineRef {unBaselineRef :: SHA256}+  deriving stock (Eq, Ord, Show, Generic)++-- | Stable identity for a rendered command invocation.+newtype CommandFingerprint = CommandFingerprint {unCommandFingerprint :: SHA256}+  deriving stock (Eq, Ord, Show, Generic)++-- | Evidence that one rendered command completed successfully.+data CommandReceipt = CommandReceipt+  { fingerprint :: CommandFingerprint,+    moduleName :: ModuleName,+    command :: Text,+    workDir :: Maybe FilePath,+    completedAt :: UTCTime+  }+  deriving stock (Eq, Show, Generic)++-- | Reproducible state for one module instance in an application.+data AppliedInstanceState = AppliedInstanceState+  { name :: ModuleName,+    parentVars :: ParentVars,+    source :: FilePath,+    moduleVersion :: Maybe Text,+    resolvedVars :: Map VarName Text+  }+  deriving stock (Eq, Show, Generic)++-- | A complete, re-runnable top-level module or recipe composition.+data AppliedComposition = AppliedComposition+  { applicationId :: ApplicationId,+    target :: AppliedTarget,+    targetSource :: FilePath,+    targetVersion :: Maybe Text,+    additionalModules :: [ModuleName],+    namespace :: Maybe Text,+    context :: Maybe Text,+    instances :: [AppliedInstanceState],+    commandReceipts :: Map CommandFingerprint CommandReceipt,+    appliedAt :: UTCTime+  }+  deriving stock (Eq, Show, Generic)+ -- | Recipe provenance recorded in the manifest when a recipe is used. data AppliedRecipe = AppliedRecipe   { name :: RecipeName,@@ -494,6 +562,19 @@   }   deriving stock (Eq, Show, Generic) +-- | A durable receipt for one successfully completed agent-guided blueprint+-- migration edge. Exact-edge identity is the blueprint 'name' together with+-- 'fromVersion' and 'toVersion'; the remaining fields are audit metadata.+data AppliedBlueprintMigration = AppliedBlueprintMigration+  { name :: ModuleName,+    blueprintVersion :: Maybe Text,+    fromVersion :: Text,+    toVersion :: Text,+    appliedAt :: UTCTime,+    agentSessionId :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)+ -- | A module that has been applied to generate files. -- -- The @parentVars@ field disambiguates multiple invocations of the same@@ -516,7 +597,9 @@   { hash :: SHA256,     moduleName :: ModuleName,     strategy :: Strategy,-    generatedAt :: UTCTime+    generatedAt :: UTCTime,+    baseline :: Maybe BaselineRef,+    applicationIds :: Set ApplicationId   }   deriving stock (Eq, Show, Generic) 

@@ -1,5 +1,6 @@ module Seihou.Core.Variable   ( resolveVariables,+    resolveVariablesWithSaved,     coerceValue,     coerceDefault,     validateVarValue,@@ -137,13 +138,14 @@ -- -- Precedence chain (highest to lowest): -- 1. CLI overrides (@--var@ flags)--- 2. Environment variables (@SEIHOU_VAR_@ prefix)--- 3. Local project config (@.seihou\/config.dhall@)--- 4. Namespace config (@~\/.config\/seihou\/namespaces\/\<ns\>\/config.dhall@)--- 5. Context config (@~\/.config\/seihou\/contexts\/\<ctx\>\/config.dhall@)--- 6. Global config (@~\/.config\/seihou\/config.dhall@)--- 7. Parent-supplied vars (from parameterized dependencies)--- 8. Module defaults+-- 2. Saved application values (when supplied by the update resolver)+-- 3. Environment variables (@SEIHOU_VAR_@ prefix)+-- 4. Local project config (@.seihou\/config.dhall@)+-- 5. Namespace config (@~\/.config\/seihou\/namespaces\/\<ns\>\/config.dhall@)+-- 6. Context config (@~\/.config\/seihou\/contexts\/\<ctx\>\/config.dhall@)+-- 7. Global config (@~\/.config\/seihou\/config.dhall@)+-- 8. Parent-supplied vars (from parameterized dependencies)+-- 9. Module defaults resolveVariables ::   [VarDecl] ->   Map VarName Text -> -- CLI overrides@@ -157,6 +159,26 @@   Map VarName (Text, ModuleName) -> -- Parent-supplied vars   Either [VarError] (Map VarName ResolvedVar) resolveVariables decls cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig parentVars =+  resolveVariablesWithSaved decls cliOverrides Map.empty envVars namespace context localConfig nsConfig ctxConfig globalConfig parentVars++-- | Resolve variables with values saved from a previously accepted application.+-- Explicit CLI values remain authoritative; saved values are re-coerced through+-- the candidate declaration before any ambient environment or config layer is+-- considered.+resolveVariablesWithSaved ::+  [VarDecl] ->+  Map VarName Text -> -- CLI overrides+  Map VarName Text -> -- Saved application values+  Map Text Text -> -- Environment variables+  Text -> -- Namespace name (used in provenance tagging)+  Text -> -- Context name (used in provenance tagging)+  Map VarName Text -> -- Local config+  Map VarName Text -> -- Namespace config+  Map VarName Text -> -- Context config+  Map VarName Text -> -- Global config+  Map VarName (Text, ModuleName) -> -- Parent-supplied vars+  Either [VarError] (Map VarName ResolvedVar)+resolveVariablesWithSaved decls cliOverrides savedValues envVars namespace context localConfig nsConfig ctxConfig globalConfig parentVars =   case partitionResults (map resolveOne decls) of     ([], resolved) -> Right (Map.fromList (catMaybes resolved))     (errs, _) -> Left errs@@ -167,27 +189,38 @@           ty = decl.type_        in case lookupCLI name ty of             Just result -> fmap Just (result >>= validateAndWrap decl)-            Nothing -> case lookupEnv name ty of+            Nothing -> case lookupSaved name ty of               Just result -> fmap Just (result >>= validateAndWrap decl)-              Nothing -> case lookupConfig name ty localConfig FromLocalConfig of+              Nothing -> case lookupEnv name ty of                 Just result -> fmap Just (result >>= validateAndWrap decl)-                Nothing -> case lookupConfig name ty nsConfig (FromNamespaceConfig namespace) of+                Nothing -> case lookupConfig name ty localConfig FromLocalConfig of                   Just result -> fmap Just (result >>= validateAndWrap decl)-                  Nothing -> case lookupConfig name ty ctxConfig (FromContextConfig context) of+                  Nothing -> case lookupConfig name ty nsConfig (FromNamespaceConfig namespace) of                     Just result -> fmap Just (result >>= validateAndWrap decl)-                    Nothing -> case lookupConfig name ty globalConfig FromGlobalConfig of+                    Nothing -> case lookupConfig name ty ctxConfig (FromContextConfig context) of                       Just result -> fmap Just (result >>= validateAndWrap decl)-                      Nothing -> case lookupParent name ty of+                      Nothing -> case lookupConfig name ty globalConfig FromGlobalConfig of                         Just result -> fmap Just (result >>= validateAndWrap decl)-                        Nothing -> case decl.default_ of-                          Just defVal ->-                            case coerceDefault name ty defVal of-                              Left err -> Left err-                              Right val -> fmap Just (validateAndWrap decl (val, FromDefault))-                          Nothing-                            | decl.required -> Left (MissingRequiredVar name)-                            | otherwise -> Right Nothing+                        Nothing -> case lookupParent name ty of+                          Just result -> fmap Just (result >>= validateAndWrap decl)+                          Nothing -> case decl.default_ of+                            Just defVal ->+                              case coerceDefault name ty defVal of+                                Left err -> Left err+                                Right val -> fmap Just (validateAndWrap decl (val, FromDefault))+                            Nothing+                              | decl.required -> Left (MissingRequiredVar name)+                              | otherwise -> Right Nothing +    lookupSaved :: VarName -> VarType -> Maybe (Either VarError (VarValue, VarSource))+    lookupSaved name ty =+      case Map.lookup name savedValues of+        Nothing -> Nothing+        Just rawText ->+          Just $ case coerceValue name ty rawText of+            Left err -> Left err+            Right val -> Right (val, FromApplication)+     lookupParent :: VarName -> VarType -> Maybe (Either VarError (VarValue, VarSource))     lookupParent name ty =       case Map.lookup name parentVars of@@ -274,6 +307,7 @@      showSource :: VarSource -> Text     showSource FromCLI = "[--var]"+    showSource FromApplication = "[application]"     showSource (FromEnv envKey) = "[env " <> envKey <> "]"     showSource FromLocalConfig = "[local config]"     showSource (FromNamespaceConfig ns) = "[namespace: " <> ns <> "]"

@@ -29,6 +29,7 @@     removalActionDecoder,     migrationDecoder,     migrationOpDecoder,+    blueprintMigrationDecoder,   ) where @@ -46,7 +47,7 @@ import Dhall.Marshal.Decode (Decoder (..), Extractor, bool, constructor, field, maybe, natural, string, union) import Dhall.Src (Src) import Seihou.Core.Expr (parseExpr)-import Seihou.Core.Migration (Migration (..), MigrationOp (..))+import Seihou.Core.Migration (BlueprintMigration (..), Migration (..), MigrationOp (..)) import Seihou.Core.Registry (Registry (..), RegistryEntry (..)) import Seihou.Core.Types import Seihou.Core.Variable (coerceDefault)@@ -208,6 +209,16 @@         <*> field "ops" (list migrationOpDecoder)     ) +-- | Decoder for one agent-guided blueprint migration edge.+blueprintMigrationDecoder :: Decoder BlueprintMigration+blueprintMigrationDecoder =+  record+    ( BlueprintMigration+        <$> field "from" strictText+        <*> field "to" strictText+        <*> field "prompt" strictText+    )+ -- | Decoder for a 'MigrationOp' from a Dhall union value. -- The union variants must match @schema/MigrationOp.dhall@. migrationOpDecoder :: Decoder MigrationOp@@ -267,19 +278,21 @@ -- | Decoder for the top-level Blueprint type from Dhall. blueprintDecoder :: Decoder Blueprint blueprintDecoder =-  record-    ( Blueprint-        <$> field "name" moduleNameDecoder-        <*> field "version" (maybe strictText)-        <*> field "description" (maybe strictText)-        <*> field "prompt" strictText-        <*> field "vars" (list varDeclDecoder)-        <*> field "prompts" (list promptDecoder)-        <*> field "baseModules" (list dependencyDecoder)-        <*> field "files" (list blueprintFileDecoder)-        <*> field "allowedTools" (maybe (list strictText))-        <*> field "tags" (list strictText)-    )+  withDefaults [("migrations", emptyMigrationList)] $+    record+      ( Blueprint+          <$> field "name" moduleNameDecoder+          <*> field "version" (maybe strictText)+          <*> field "description" (maybe strictText)+          <*> field "prompt" strictText+          <*> field "vars" (list varDeclDecoder)+          <*> field "prompts" (list promptDecoder)+          <*> field "baseModules" (list dependencyDecoder)+          <*> field "files" (list blueprintFileDecoder)+          <*> field "allowedTools" (maybe (list strictText))+          <*> field "tags" (list strictText)+          <*> field "migrations" (list blueprintMigrationDecoder)+      )  -- | Evaluate a @blueprint.dhall@ file and decode it into a 'Blueprint'. -- Returns 'Left' with a 'ModuleLoadError' if evaluation or decoding fails.

@@ -0,0 +1,38 @@+module Seihou.Effect.BaselineStore+  ( BaselineStore (..),+    BaselineError (..),+    putBaseline,+    readBaseline,+    pruneBaselines,+  )+where++import Data.Set (Set)+import Seihou.Core.Types (BaselineRef, SHA256)+import Seihou.Prelude++-- | Failures that make a generated baseline unavailable. Store failures are+-- represented here for callers that validate the project file before writing;+-- interpreter-level filesystem exceptions still propagate through 'IOE'.+data BaselineError+  = BaselineMissing BaselineRef+  | BaselineCorrupt BaselineRef SHA256+  | BaselineStoreFailure Text+  deriving stock (Eq, Show)++-- | Content-addressed storage for generated file ancestors.+data BaselineStore :: Effect where+  PutBaseline :: Text -> BaselineStore m BaselineRef+  ReadBaseline :: BaselineRef -> BaselineStore m (Either BaselineError Text)+  PruneBaselines :: Set BaselineRef -> BaselineStore m [BaselineRef]++type instance DispatchOf BaselineStore = Dynamic++putBaseline :: (BaselineStore :> es) => Text -> Eff es BaselineRef+putBaseline content = send (PutBaseline content)++readBaseline :: (BaselineStore :> es) => BaselineRef -> Eff es (Either BaselineError Text)+readBaseline ref = send (ReadBaseline ref)++pruneBaselines :: (BaselineStore :> es) => Set BaselineRef -> Eff es [BaselineRef]+pruneBaselines refs = send (PruneBaselines refs)

@@ -0,0 +1,84 @@+module Seihou.Effect.BaselineStoreInterp+  ( runBaselineStore,+  )+where++import Control.Monad (filterM, unless, when)+import Data.Maybe (mapMaybe)+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.Core.Types (BaselineRef (..), SHA256 (..))+import Seihou.Effect.BaselineStore (BaselineError (..), BaselineStore (..))+import Seihou.Effect.Filesystem+import Seihou.Manifest.Hash (baselineRefForContent, baselineRefFromText, hashContent)+import Seihou.Prelude++-- | Interpret baseline operations under the supplied baseline directory, such+-- as @.seihou/baselines@. The interpreter validates every reference before+-- deriving a path, even though normal references come from the manifest+-- decoder or 'baselineRefForContent'.+runBaselineStore ::+  (Filesystem :> es) =>+  FilePath ->+  Eff (BaselineStore : es) a ->+  Eff es a+runBaselineStore baselineDir = interpret $ \_ -> \case+  PutBaseline content -> do+    let ref = baselineRefForContent content+        finalPath = checkedBaselinePath baselineDir ref+        tempPath = finalPath <> ".tmp"+    createDirectoryIfMissing True baselineDir+    tempExists <- doesFileExist tempPath+    when tempExists (removeFile tempPath)+    finalExists <- doesFileExist finalPath+    reusable <-+      if finalExists+        then ((== ref.unBaselineRef) . hashContent) <$> readFileText finalPath+        else pure False+    unless reusable $ do+      writeFileText tempPath content+      when finalExists (removeFile finalPath)+      renamePath tempPath finalPath+    pure ref+  ReadBaseline ref -> do+    case baselinePath baselineDir ref of+      Nothing -> pure (Left (BaselineStoreFailure "invalid baseline reference"))+      Just path -> do+        exists <- doesFileExist path+        if not exists+          then pure (Left (BaselineMissing ref))+          else do+            content <- readFileText path+            let actual = hashContent content+            if actual == ref.unBaselineRef+              then pure (Right content)+              else pure (Left (BaselineCorrupt ref actual))+  PruneBaselines referenced -> do+    exists <- doesDirectoryExist baselineDir+    if not exists+      then pure []+      else do+        entries <- listDirectory baselineDir+        let candidates = mapMaybe (baselineRefFromText . T.pack) entries+        removable <- filterM (isValidUnreferenced referenced) candidates+        mapM_ (removeFile . checkedBaselinePath baselineDir) removable+        pure removable+  where+    isValidUnreferenced referenced ref+      | Set.member ref referenced = pure False+      | otherwise = do+          let path = checkedBaselinePath baselineDir ref+          isFile <- doesFileExist path+          if not isFile+            then pure False+            else ((== ref.unBaselineRef) . hashContent) <$> readFileText path++baselinePath :: FilePath -> BaselineRef -> Maybe FilePath+baselinePath root ref = do+  normalized <- baselineRefFromText ref.unBaselineRef.unSHA256+  pure (root </> T.unpack normalized.unBaselineRef.unSHA256)++checkedBaselinePath :: FilePath -> BaselineRef -> FilePath+checkedBaselinePath root ref = case baselinePath root ref of+  Just path -> path+  Nothing -> error "checkedBaselinePath: internally generated invalid baseline reference"

@@ -0,0 +1,46 @@+module Seihou.Effect.BaselineStorePure+  ( runBaselineStorePure,+  )+where++import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Effectful.State.Static.Local (State, get, modify, runState)+import Seihou.Core.Types (BaselineRef (..))+import Seihou.Effect.BaselineStore (BaselineError (..), BaselineStore (..))+import Seihou.Manifest.Hash (baselineRefForContent, hashContent)+import Seihou.Prelude++-- | Run the baseline store entirely in memory. The map is intentionally+-- exposed in the result so tests can inspect deduplication and pruning.+runBaselineStorePure ::+  Map BaselineRef Text ->+  Eff (BaselineStore : es) a ->+  Eff es (a, Map BaselineRef Text)+runBaselineStorePure initial = reinterpret (runState initial) handler+  where+    handler :: (State (Map BaselineRef Text) :> es') => EffectHandler BaselineStore es'+    handler _ = \case+      PutBaseline content -> do+        let ref = baselineRefForContent content+        modify @(Map BaselineRef Text) (Map.insert ref content)+        pure ref+      ReadBaseline ref -> do+        store <- get @(Map BaselineRef Text)+        pure $ case Map.lookup ref store of+          Nothing -> Left (BaselineMissing ref)+          Just content ->+            let actual = hashContent content+             in if actual == ref.unBaselineRef+                  then Right content+                  else Left (BaselineCorrupt ref actual)+      PruneBaselines referenced -> do+        store <- get @(Map BaselineRef Text)+        let removable =+              Map.keysSet $+                Map.filterWithKey+                  (\ref content -> Set.notMember ref referenced && hashContent content == ref.unBaselineRef)+                  store+        modify @(Map BaselineRef Text) (`Map.withoutKeys` removable)+        pure (Set.toAscList removable)

@@ -0,0 +1,54 @@+module Seihou.Engine.Baseline+  ( recordGeneratedBaselines,+    manifestBaselineRefs,+  )+where++import Control.Monad (foldM)+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.Core.Types (BaselineRef, FileRecord (..), Manifest (..))+import Seihou.Effect.BaselineStore (BaselineError (..), BaselineStore, putBaseline)+import Seihou.Effect.Filesystem (Filesystem, doesFileExist, readFileText)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Prelude++-- | Capture the exact post-execution bytes for every returned file record.+-- The same content supplies both the generated baseline and the applied disk+-- hash, which is essential for patch operations whose final content only+-- exists after execution.+recordGeneratedBaselines ::+  (Filesystem :> es, BaselineStore :> es) =>+  FilePath ->+  Map FilePath FileRecord ->+  Eff es (Either BaselineError (Map FilePath FileRecord))+recordGeneratedBaselines targetDir records =+  foldM capture (Right Map.empty) (Map.toAscList records)+  where+    capture (Left err) _ = pure (Left err)+    capture (Right captured) (path, record) = do+      let fullPath = targetDir </> path+      exists <- doesFileExist fullPath+      if not exists+        then+          pure $+            Left $+              BaselineStoreFailure+                ("generated file disappeared before baseline capture: " <> T.pack fullPath)+        else do+          content <- readFileText fullPath+          ref <- putBaseline content+          let enriched =+                record+                  { hash = hashContent content,+                    baseline = Just ref+                  }+          pure (Right (Map.insert path enriched captured))++-- | Every blob protected by the currently durable manifest. Callers pass this+-- set to 'pruneBaselines' only after publishing that manifest.+manifestBaselineRefs :: Manifest -> Set BaselineRef+manifestBaselineRefs manifest =+  Set.fromList (mapMaybe (.baseline) (Map.elems manifest.files))

@@ -50,7 +50,9 @@             { hash = hashContent content,               moduleName = ownerFor dest,               strategy = strat,-              generatedAt = now+              generatedAt = now,+              baseline = Nothing,+              applicationIds = mempty             }     pure (Just (dest, record))   CreateDirOp path -> do@@ -66,10 +68,12 @@             { hash = hashContent content,               moduleName = ownerFor dest,               strategy = Copy,-              generatedAt = now+              generatedAt = now,+              baseline = Nothing,+              applicationIds = mempty             }     pure (Just (dest, record))-  RunCommandOp _ _ -> do+  RunCommandOp {} -> do     -- Command execution is deferred to the CLI layer.     pure Nothing   PatchFileOp dest newContent patchOp' strat modName -> do@@ -90,7 +94,9 @@                 { hash = hashContent merged,                   moduleName = ownerFor dest,                   strategy = strat,-                  generatedAt = now+                  generatedAt = now,+                  baseline = Nothing,+                  applicationIds = mempty                 }         pure (Just (dest, record)) @@ -105,7 +111,7 @@     formatOp (WriteFileOp dest _ _) = "  write " <> T.pack dest     formatOp (CreateDirOp path) = "  mkdir " <> T.pack path     formatOp (CopyFileOp src dest) = "  copy  " <> T.pack src <> " -> " <> T.pack dest-    formatOp (RunCommandOp cmd _) = "  run   " <> cmd+    formatOp RunCommandOp {command = cmd} = "  run   " <> cmd     formatOp (PatchFileOp dest _ patchOp' _ modName) =       "  patch " <> T.pack dest <> " (" <> formatPatchOp patchOp' <> " from " <> modName.unModuleName <> ")"     formatPatchOp AppendFile = "append-file"

@@ -7,6 +7,7 @@ import Control.Exception (IOException, SomeException, catch, try) import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as AesonPretty+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 TE@@ -39,7 +40,7 @@   results <- mapM (compileStep baseDir modName vars) modul.steps   let (allErrors, allOps) = partitionResults results   if null allErrors-    then case compileCommands vars modul.commands of+    then case compileCommands modName vars modul.commands of       Left cmdErrs -> pure (Left cmdErrs)       Right cmdOps -> pure (Right (deduplicateDirs (concat allOps) ++ cmdOps))     else pure (Left (concat allErrors))@@ -47,39 +48,48 @@ -- | Compile commands into 'RunCommandOp' operations, interpolating -- @{{var}}@ placeholders in the @run@ and @workDir@ fields. -- Commands whose @when@ condition evaluates to False are skipped.-compileCommands :: Map VarName VarValue -> [Command] -> Either [Text] [Operation]-compileCommands vars = foldl' go (Right [])+compileCommands :: ModuleName -> Map VarName VarValue -> [Command] -> Either [Text] [Operation]+compileCommands modName vars commands =+  case foldl' go (Map.empty, [], []) commands of+    (_, ops, []) -> Right ops+    (_, _, errs) -> Left errs   where-    go (Left errs) cmd = Left (errs ++ compileErrors cmd)-    go (Right ops) cmd =-      let shouldRun = case cmd.condition of-            Nothing -> True-            Just expr -> evalExpr vars expr-       in if shouldRun-            then case compileOneCommand vars cmd of-              Left cmdErrs -> Left cmdErrs-              Right op -> Right (ops ++ [op])-            else Right ops+    go state@(_, _, errs) cmd+      | not (shouldRun cmd) = state+      | otherwise = case compileOneCommand vars cmd of+          Left cmdErrs -> let (counts, ops, _) = state in (counts, ops, errs ++ cmdErrs)+          Right (runText, commandWorkDir) ->+            let (counts, ops, _) = state+                key = (runText, commandWorkDir)+                occurrence = Map.findWithDefault 0 key counts+                operation =+                  RunCommandOp+                    { command = runText,+                      workDir = commandWorkDir,+                      moduleName = modName,+                      occurrence = occurrence+                    }+             in (Map.insert key (occurrence + 1) counts, ops ++ [operation], errs) -    compileErrors cmd = case compileOneCommand vars cmd of-      Left es -> es-      Right _ -> []+    shouldRun cmd = case cmd.condition of+      Nothing -> True+      Just expr -> evalExpr vars expr  -- | Compile a single command, interpolating placeholders in @run@ and @workDir@.-compileOneCommand :: Map VarName VarValue -> Command -> Either [Text] Operation+compileOneCommand :: Map VarName VarValue -> Command -> Either [Text] (Text, Maybe FilePath) compileOneCommand vars cmd =   case renderCommand cmd.run vars of     Left placeholderErrors -> Left (map formatPlaceholderError placeholderErrors)     Right runText ->       case cmd.workDir of-        Nothing -> Right (RunCommandOp runText Nothing)+        Nothing -> Right (runText, Nothing)         Just wd ->           case renderCommand wd vars of             Left placeholderErrors -> Left (map formatPlaceholderError placeholderErrors)             Right renderedWd ->               case validateRenderedCommandWorkDir renderedWd of                 Left err -> Left [err]-                Right safeWd -> Right (RunCommandOp runText (Just (T.unpack safeWd)))+                Right safeWd -> Right (runText, Just (T.unpack safeWd))  -- | Compile a single step into operations (or skip it). -- If the step has a patch operation, it produces a 'PatchFileOp'; otherwise

@@ -32,7 +32,7 @@         previewModule :: Maybe ModuleName       }   | DirPreview FilePath-  | CommandPreview Text+  | CommandPreview Text (Maybe ModuleName)   | OrphanPreview FilePath ModuleName   deriving stock (Eq, Show) @@ -42,7 +42,15 @@ -- operations are treated as new. buildPreview :: [Operation] -> Maybe DiffResult -> Map FilePath ModuleName -> [PreviewLine] buildPreview ops mDiff ownerMap =-  let opLines = map (opToPreview mDiff ownerMap) ops+  let commandOwners =+        Map.fromListWith+          Set.union+          [ (command, Set.singleton moduleName)+          | RunCommandOp {command, moduleName} <- ops+          ]+      commandsNeedingOwner =+        Map.keysSet (Map.filter ((> 1) . Set.size) commandOwners)+      opLines = map (opToPreview mDiff ownerMap commandsNeedingOwner) ops       orphanLines = case mDiff of         Nothing -> []         Just diff ->@@ -55,24 +63,27 @@    in opLines ++ orphanLines  -- | Convert a single operation to a preview line.-opToPreview :: Maybe DiffResult -> Map FilePath ModuleName -> Operation -> PreviewLine-opToPreview mDiff ownerMap (WriteFileOp dest _ strat) =+opToPreview :: Maybe DiffResult -> Map FilePath ModuleName -> Set Text -> Operation -> PreviewLine+opToPreview mDiff ownerMap _ (WriteFileOp dest _ strat) =   FilePreview     { previewStatus = lookupStatus dest mDiff,       previewPath = dest,       previewAnnotation = strategyName strat,       previewModule = Map.lookup dest ownerMap     }-opToPreview _ _ (CreateDirOp path) = DirPreview path-opToPreview mDiff ownerMap (CopyFileOp _ dest) =+opToPreview _ _ _ (CreateDirOp path) = DirPreview path+opToPreview mDiff ownerMap _ (CopyFileOp _ dest) =   FilePreview     { previewStatus = lookupStatus dest mDiff,       previewPath = dest,       previewAnnotation = "copy",       previewModule = Map.lookup dest ownerMap     }-opToPreview _ _ (RunCommandOp cmd _) = CommandPreview cmd-opToPreview mDiff ownerMap (PatchFileOp dest _ _patchOp' _ modName') =+opToPreview _ _ commandsNeedingOwner RunCommandOp {command, moduleName} =+  CommandPreview+    command+    (if Set.member command commandsNeedingOwner then Just moduleName else Nothing)+opToPreview mDiff ownerMap _ (PatchFileOp dest _ _patchOp' _ modName') =   FilePreview     { previewStatus = lookupStatus dest mDiff,       previewPath = dest,@@ -115,8 +126,10 @@ renderNonFileLine :: PreviewLine -> Text renderNonFileLine (DirPreview path) =   "    mkdir  " <> T.pack path-renderNonFileLine (CommandPreview cmd) =-  "    run    " <> cmd+renderNonFileLine (CommandPreview cmd mOwner) =+  "    run    " <> cmd <> ownerSuffix mOwner+  where+    ownerSuffix = maybe "" (\owner -> "  (" <> owner.unModuleName <> ")") renderNonFileLine (OrphanPreview path modName') =   "    [orphaned]  " <> T.pack path <> "  (orphaned from " <> modName'.unModuleName <> ")" renderNonFileLine _ = ""

@@ -0,0 +1,594 @@+module Seihou.Engine.Reconcile+  ( DesiredFileOwner (..),+    DesiredFile (..),+    ReconciliationReason (..),+    ObservedFile (..),+    PlannedFileState (..),+    ResolvedFileConflict (..),+    FileReconciliation (..),+    ReconciliationPlan (..),+    ReconciliationError (..),+    FileConflictChoice (..),+    OrphanChoice (..),+    ReconciliationSummary (..),+    planReconciliation,+    planReconciliationWith,+    resolveFileConflict,+    resolveEditedOrphan,+    reconciliationSummary,+    reconciliationMutationPaths,+    unresolvedPaths,+  )+where++import Control.Monad (foldM)+import Data.Foldable (traverse_)+import Data.List (foldl')+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types hiding (KeepCurrent)+import Seihou.Effect.BaselineStore (BaselineError, BaselineStore, readBaseline)+import Seihou.Effect.Filesystem (Filesystem, doesFileExist, readFileText)+import Seihou.Engine.Section (applyTextPatch)+import Seihou.Engine.ThreeWayMerge (MergeOutcome (..), threeWayMerge)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Prelude+import System.FilePath (takeDirectory)++-- | Ownership supplied by the update orchestrator for one desired path.+-- The application set is path-specific: a batch may update several+-- applications without every application contributing to every path.+data DesiredFileOwner = DesiredFileOwner+  { moduleName :: ModuleName,+    applicationIds :: Set ApplicationId+  }+  deriving stock (Eq, Show)++-- | The final generated side after all operations for a path are replayed.+data DesiredFile = DesiredFile+  { path :: FilePath,+    generatedContent :: Text,+    moduleName :: ModuleName,+    strategy :: Strategy,+    applicationIds :: Set ApplicationId+  }+  deriving stock (Eq, Show)++data ReconciliationReason+  = MissingTrustedBaseline+  | CurrentFileMissing+  | MergeDriverUnavailable Text+  | OverlappingEdits+  deriving stock (Eq, Show)++-- | The disk snapshot used while planning. Applying verifies every snapshot+-- before the first mutation, so a resolution cannot overwrite later edits.+data ObservedFile = ObservedFile+  { existed :: Bool,+    contentHash :: Maybe SHA256+  }+  deriving stock (Eq, Show)++-- | The exact generated ancestor and applied bytes a resolved action will+-- publish. @writeToDisk@ is false for paths already containing those bytes.+-- @recordedHash@ may intentionally remain the prior applied hash for a+-- user-only edit that generation did not change.+data PlannedFileState = PlannedFileState+  { generatedBaseline :: Text,+    appliedContent :: Text,+    recordedHash :: SHA256,+    writeToDisk :: Bool+  }+  deriving stock (Eq, Show)++data ResolvedFileConflict = ResolvedFileConflict+  { choice :: FileConflictChoice,+    state :: PlannedFileState+  }+  deriving stock (Eq, Show)++data FileReconciliation+  = FileCreate DesiredFile PlannedFileState ObservedFile+  | FileUpdate DesiredFile PlannedFileState ObservedFile (Maybe FileRecord)+  | FileAutoMerge DesiredFile PlannedFileState ObservedFile (Maybe FileRecord)+  | FileUnchanged DesiredFile PlannedFileState ObservedFile (Maybe FileRecord)+  | FileConflict+      DesiredFile+      Text+      Text+      ReconciliationReason+      ObservedFile+      (Maybe FileRecord)+      (Maybe ResolvedFileConflict)+  | FileDeleteSafe FilePath FileRecord ObservedFile+  | FileOrphanEdited FilePath FileRecord Text ObservedFile (Maybe OrphanChoice)+  | FileReleaseSharedOwnership FilePath FileRecord ObservedFile+  | FileAlreadyAbsent FilePath FileRecord ObservedFile+  deriving stock (Eq, Show)++data ReconciliationPlan = ReconciliationPlan+  { applicationIds :: Set ApplicationId,+    files :: Map FilePath FileReconciliation,+    requiredDirectories :: Set FilePath+  }+  deriving stock (Eq, Show)++data ReconciliationError+  = InvalidReconciliationPath FilePath Text+  | MissingDesiredOwner FilePath+  | DesiredOwnerOutsideSelection FilePath (Set ApplicationId)+  | SharedPathRequiresApplications FilePath (Set ApplicationId)+  | CopySourceUnavailable FilePath+  | PatchMaterializationFailed FilePath PatchOp ModuleName Text+  | ReconciliationPathNotFound FilePath+  | NotAFileConflict FilePath+  | NotAnEditedOrphan FilePath+  | UpdateAborted FilePath+  deriving stock (Eq, Show)++data FileConflictChoice+  = AcceptGenerated+  | KeepCurrent+  | WriteConflictMarkers+  | AbortUpdate+  deriving stock (Eq, Show)++data OrphanChoice+  = DeleteEditedOrphan+  | RetainTrackedOrphan+  | DetachAndKeepOrphan+  | AbortOrphanUpdate+  deriving stock (Eq, Show)++data ReconciliationSummary = ReconciliationSummary+  { creates :: Int,+    updates :: Int,+    merged :: Int,+    unchanged :: Int,+    conflicts :: Int,+    safeDeletes :: Int,+    editedOrphans :: Int,+    sharedOwnership :: Int+  }+  deriving stock (Eq, Show)++-- | Production planner using the repository filesystem and baseline effects,+-- with EP-65's Git-backed merge driver for dual edits.+planReconciliation ::+  (Filesystem :> es, BaselineStore :> es, IOE :> es) =>+  FilePath ->+  Manifest ->+  Set ApplicationId ->+  [Operation] ->+  Map FilePath DesiredFileOwner ->+  Eff es (Either ReconciliationError ReconciliationPlan)+planReconciliation projectRoot manifest selected operations ownerMap =+  planReconciliationWith+    readProjectFile+    readCopySource+    readBaseline+    (\base current generated -> liftIO (threeWayMerge base current generated))+    manifest+    selected+    operations+    ownerMap+  where+    readProjectFile relativePath = do+      let fullPath = projectRoot </> relativePath+      exists <- doesFileExist fullPath+      if exists then Just <$> readFileText fullPath else pure Nothing+    readCopySource sourcePath = do+      exists <- doesFileExist sourcePath+      if exists+        then Right <$> readFileText sourcePath+        else pure (Left (CopySourceUnavailable sourcePath))++-- | Backend-parametric planner. Tests use maps for disk, copy-source, and+-- baseline reads while production supplies effects. The function is read-only.+planReconciliationWith ::+  (Monad m) =>+  (FilePath -> m (Maybe Text)) ->+  (FilePath -> m (Either ReconciliationError Text)) ->+  (BaselineRef -> m (Either BaselineError Text)) ->+  (Text -> Text -> Text -> m MergeOutcome) ->+  Manifest ->+  Set ApplicationId ->+  [Operation] ->+  Map FilePath DesiredFileOwner ->+  m (Either ReconciliationError ReconciliationPlan)+planReconciliationWith readDisk readCopy readStoredBaseline mergeContents manifest selected operations ownerMap =+  case validateInputs selected operations ownerMap manifest of+    Left err -> pure (Left err)+    Right (grouped, directories) -> do+      desiredResult <-+        traverse+          (materializeOne readDisk readCopy readStoredBaseline ownerMap manifest)+          grouped+      case sequence desiredResult of+        Left err -> pure (Left err)+        Right desiredContexts -> do+          classified <- traverse (classifyDesired mergeContents) desiredContexts+          orphaned <- classifyOrphans readDisk manifest selected (Map.keysSet grouped)+          pure $ do+            desiredFilesWithPaths <- sequence classified+            orphanFiles <- orphaned+            let desiredFiles = Map.map snd desiredFilesWithPaths+                allFiles = Map.union desiredFiles orphanFiles+                parentDirectories =+                  Set.fromList+                    [ parent+                    | path <- Map.keys grouped,+                      let parent = takeDirectory path,+                      parent /= "."+                    ]+            Right+              ReconciliationPlan+                { applicationIds = selected,+                  files = allFiles,+                  requiredDirectories = Set.union directories parentDirectories+                }++data DesiredContext = DesiredContext+  { desired :: DesiredFile,+    current :: Maybe Text,+    baseline :: Maybe Text,+    priorRecord :: Maybe FileRecord,+    observed :: ObservedFile,+    missingTrustedBaseline :: Bool+  }++validateInputs ::+  Set ApplicationId ->+  [Operation] ->+  Map FilePath DesiredFileOwner ->+  Manifest ->+  Either ReconciliationError (Map FilePath [Operation], Set FilePath)+validateInputs selected operations ownerMap manifest = do+  let grouped = groupFileOperations operations+      directories = Set.fromList [path | CreateDirOp path <- operations]+  traverse_ validateManagedPath (Map.keys grouped)+  traverse_ validateManagedPath (Set.toList directories)+  traverse_ (validateOwner selected ownerMap manifest) (Map.keys grouped)+  pure (grouped, directories)++validateOwner ::+  Set ApplicationId ->+  Map FilePath DesiredFileOwner ->+  Manifest ->+  FilePath ->+  Either ReconciliationError ()+validateOwner selected ownerMap manifest path = case Map.lookup path ownerMap of+  Nothing -> Left (MissingDesiredOwner path)+  Just owner+    | not (owner.applicationIds `Set.isSubsetOf` selected) ->+        Left (DesiredOwnerOutsideSelection path (owner.applicationIds Set.\\ selected))+    | otherwise -> case Map.lookup path manifest.files of+        Nothing -> Right ()+        Just record ->+          let unselectedOwners = record.applicationIds Set.\\ selected+           in if Set.null unselectedOwners+                then Right ()+                else Left (SharedPathRequiresApplications path record.applicationIds)++validateManagedPath :: FilePath -> Either ReconciliationError ()+validateManagedPath rawPath = case validateProjectRelativePath (T.pack rawPath) of+  Left err -> Left (InvalidReconciliationPath rawPath err)+  Right safePath+    | safePath /= rawPath ->+        Left (InvalidReconciliationPath rawPath "path must not contain surrounding whitespace")+    | safePath == "." ->+        Left (InvalidReconciliationPath rawPath "path must name a project file or directory")+    | targetsControlPath safePath ->+        Left (InvalidReconciliationPath rawPath "path targets Seihou or Git control data")+    | otherwise -> Right ()++targetsControlPath :: FilePath -> Bool+targetsControlPath path = case pathSegments path of+  firstSegment : _ -> firstSegment == ".seihou" || firstSegment == ".git"+  [] -> False++pathSegments :: FilePath -> [Text]+pathSegments = filter (not . T.null) . T.split (\character -> character == '/' || character == '\\') . T.pack++groupFileOperations :: [Operation] -> Map FilePath [Operation]+groupFileOperations = foldl' addOperation Map.empty+  where+    addOperation grouped operation = case operationDestination operation of+      Nothing -> grouped+      Just path -> Map.insertWith (flip (++)) path [operation] grouped++operationDestination :: Operation -> Maybe FilePath+operationDestination (WriteFileOp path _ _) = Just path+operationDestination (CopyFileOp _ path) = Just path+operationDestination (PatchFileOp path _ _ _ _) = Just path+operationDestination _ = Nothing++materializeOne ::+  (Monad m) =>+  (FilePath -> m (Maybe Text)) ->+  (FilePath -> m (Either ReconciliationError Text)) ->+  (BaselineRef -> m (Either BaselineError Text)) ->+  Map FilePath DesiredFileOwner ->+  Manifest ->+  [Operation] ->+  m (Either ReconciliationError DesiredContext)+materializeOne readDisk readCopy readStoredBaseline ownerMap manifest pathOperations = do+  let path = operationPath pathOperations+      prior = Map.lookup path manifest.files+      owner = ownerMap Map.! path+      containsReplacement = any isReplacement pathOperations+  current <- readDisk path+  trust <- case prior of+    Nothing ->+      pure+        ( Trusted+            (if containsReplacement then "" else maybe "" id current)+            False+        )+    Just record -> trustedBaseline readStoredBaseline record current+  let initial = case trust of+        Trusted content _ -> content+        Untrusted+          | prior == Nothing && not containsReplacement -> maybe "" id current+          | otherwise -> ""+  generatedResult <-+    foldM+      ( \result operation -> case result of+          Left err -> pure (Left err)+          Right existing -> applyGenerationOperation readCopy path existing operation+      )+      (Right initial)+      pathOperations+  pure $ do+    generated <- generatedResult+    let (trusted, missing, _synthetic) = case trust of+          Trusted content synthetic -> (Just content, False, synthetic)+          Untrusted -> (Nothing, prior /= Nothing, False)+        finalStrategy = operationStrategy (last pathOperations)+        desired =+          DesiredFile+            { path = path,+              generatedContent = generated,+              moduleName = owner.moduleName,+              strategy = finalStrategy,+              applicationIds = owner.applicationIds+            }+    Right+      DesiredContext+        { desired = desired,+          current = current,+          baseline = trusted,+          priorRecord = prior,+          observed = observe current,+          missingTrustedBaseline = missing+        }+  where+    operationPath (operation : _) = case operationDestination operation of+      Just path -> path+      Nothing -> error "materializeOne received a non-file operation"+    operationPath [] = error "materializeOne received an empty operation group"++data BaselineTrust = Trusted Text Bool | Untrusted++trustedBaseline ::+  (Monad m) =>+  (BaselineRef -> m (Either BaselineError Text)) ->+  FileRecord ->+  Maybe Text ->+  m BaselineTrust+trustedBaseline readStored record current = case record.baseline of+  Just ref -> do+    result <- readStored ref+    pure (either (const Untrusted) (\content -> Trusted content False) result)+  Nothing ->+    pure $ case current of+      Just content | hashContent content == record.hash -> Trusted content True+      _ -> Untrusted++applyGenerationOperation ::+  (Monad m) =>+  (FilePath -> m (Either ReconciliationError Text)) ->+  FilePath ->+  Text ->+  Operation ->+  m (Either ReconciliationError Text)+applyGenerationOperation _ _ _ (WriteFileOp _ content _) = pure (Right content)+applyGenerationOperation readCopy _ _ (CopyFileOp source _) = readCopy source+applyGenerationOperation _ path existing (PatchFileOp _ content patch _strategy moduleName) =+  pure $+    first+      (PatchMaterializationFailed path patch moduleName)+      (applyTextPatch patch moduleName "#" existing content)+applyGenerationOperation _ _ existing _ = pure (Right existing)++isReplacement :: Operation -> Bool+isReplacement WriteFileOp {} = True+isReplacement CopyFileOp {} = True+isReplacement _ = False++operationStrategy :: Operation -> Strategy+operationStrategy (WriteFileOp _ _ strategy) = strategy+operationStrategy CopyFileOp {} = Copy+operationStrategy (PatchFileOp _ _ _ strategy _) = strategy+operationStrategy _ = Template++classifyDesired ::+  (Monad m) =>+  (Text -> Text -> Text -> m MergeOutcome) ->+  DesiredContext ->+  m (Either ReconciliationError (FilePath, FileReconciliation))+classifyDesired mergeContents context = case context.current of+  Nothing -> pure $ Right (path, classifyMissing)+  Just current+    | context.missingTrustedBaseline ->+        pure $ Right (path, unresolved current current MissingTrustedBaseline)+    | otherwise -> case context.baseline of+        Nothing -> pure $ Right (path, unresolved current current MissingTrustedBaseline)+        Just baseline -> classifyPresent baseline current+  where+    desired = context.desired+    path = desired.path+    generated = desired.generatedContent+    prior = context.priorRecord+    observed = context.observed++    classifyMissing = case prior of+      Nothing -> FileCreate desired (automaticState generated True) observed+      Just _ -> unresolved "" "" CurrentFileMissing++    classifyPresent baseline current+      | current == baseline && generated == baseline =+          pure (Right (path, FileUnchanged desired (unchangedState generated current) observed prior))+      | current == baseline =+          pure (Right (path, FileUpdate desired (automaticState generated True) observed prior))+      | generated == baseline =+          let priorHash = maybe (hashContent current) (.hash) prior+              state = PlannedFileState generated current priorHash False+           in pure (Right (path, FileUnchanged desired state observed prior))+      | current == generated =+          pure (Right (path, FileUnchanged desired (unchangedState generated current) observed prior))+      | otherwise = do+          outcome <- mergeContents baseline current generated+          pure $ Right (path, fromMerge current outcome)++    fromMerge _ (MergeClean merged) =+      FileAutoMerge+        desired+        (PlannedFileState generated merged (hashContent merged) (context.current /= Just merged))+        observed+        prior+    fromMerge current (MergeConflicted markers) = unresolved current markers OverlappingEdits+    fromMerge current (MergeUnavailable message) =+      unresolved current current (MergeDriverUnavailable message)++    unresolved current markers reason =+      FileConflict desired current markers reason observed prior Nothing++    automaticState content write = PlannedFileState content content (hashContent content) write+    unchangedState baseline current = PlannedFileState baseline current (hashContent current) False++classifyOrphans ::+  (Monad m) =>+  (FilePath -> m (Maybe Text)) ->+  Manifest ->+  Set ApplicationId ->+  Set FilePath ->+  m (Either ReconciliationError (Map FilePath FileReconciliation))+classifyOrphans readDisk manifest selected desiredPaths = do+  entries <- traverse classify candidates+  pure (Right (Map.fromList entries))+  where+    candidates =+      [ (path, record)+      | (path, record) <- Map.toList manifest.files,+        Set.null (Set.intersection selected record.applicationIds) == False,+        Set.notMember path desiredPaths+      ]+    classify (path, record) = do+      current <- readDisk path+      let observed = observe current+          remainingOwners = record.applicationIds Set.\\ selected+          action+            | not (Set.null remainingOwners) = FileReleaseSharedOwnership path record observed+            | otherwise = case current of+                Nothing -> FileAlreadyAbsent path record observed+                Just content+                  | hashContent content == record.hash -> FileDeleteSafe path record observed+                  | otherwise -> FileOrphanEdited path record content observed Nothing+      pure (path, action)++observe :: Maybe Text -> ObservedFile+observe current = ObservedFile (maybe False (const True) current) (hashContent <$> current)++resolveFileConflict ::+  FilePath ->+  FileConflictChoice ->+  ReconciliationPlan ->+  Either ReconciliationError ReconciliationPlan+resolveFileConflict path choice plan = case Map.lookup path plan.files of+  Nothing -> Left (ReconciliationPathNotFound path)+  Just (FileConflict _ _ _ _ _ _ _) | choice == AbortUpdate -> Left (UpdateAborted path)+  Just (FileConflict desired current markers reason observed prior _) ->+    let applied = case choice of+          AcceptGenerated -> desired.generatedContent+          KeepCurrent -> current+          WriteConflictMarkers -> markers+          AbortUpdate -> current+        state =+          PlannedFileState+            { generatedBaseline = desired.generatedContent,+              appliedContent = applied,+              recordedHash = hashContent applied,+              writeToDisk = applied /= current || not observed.existed+            }+        resolved = FileConflict desired current markers reason observed prior (Just (ResolvedFileConflict choice state))+     in Right (replacePlanFiles plan (Map.insert path resolved plan.files))+  Just _ -> Left (NotAFileConflict path)++resolveEditedOrphan ::+  FilePath ->+  OrphanChoice ->+  ReconciliationPlan ->+  Either ReconciliationError ReconciliationPlan+resolveEditedOrphan path choice plan = case Map.lookup path plan.files of+  Nothing -> Left (ReconciliationPathNotFound path)+  Just (FileOrphanEdited _ _ _ _ _) | choice == AbortOrphanUpdate -> Left (UpdateAborted path)+  Just (FileOrphanEdited orphanPath record content observed _) ->+    Right $+      replacePlanFiles+        plan+        ( Map.insert+            path+            (FileOrphanEdited orphanPath record content observed (Just choice))+            plan.files+        )+  Just _ -> Left (NotAnEditedOrphan path)++reconciliationSummary :: ReconciliationPlan -> ReconciliationSummary+reconciliationSummary = foldl' count emptySummary . Map.elems . (.files)+  where+    emptySummary = ReconciliationSummary 0 0 0 0 0 0 0 0+    count summary reconciliation = case reconciliation of+      FileCreate _ _ _ -> addCreate summary+      FileUpdate _ _ _ _ -> addUpdate summary+      FileAutoMerge _ _ _ _ -> addMerge summary+      FileUnchanged _ _ _ _ -> addUnchanged summary+      FileConflict _ _ _ _ _ _ Nothing -> addConflict summary+      FileConflict _ _ _ _ _ _ (Just resolved) -> case resolved.choice of+        AcceptGenerated -> addUpdate summary+        KeepCurrent -> addMerge summary+        WriteConflictMarkers -> addMerge summary+        AbortUpdate -> addConflict summary+      FileDeleteSafe _ _ _ -> addSafeDelete summary+      FileOrphanEdited _ _ _ _ _ -> addEditedOrphan summary+      FileReleaseSharedOwnership _ _ _ -> addSharedOwnership summary+      FileAlreadyAbsent _ _ _ -> addUnchanged summary++    addCreate (ReconciliationSummary a b c d e f g h) = ReconciliationSummary (a + 1) b c d e f g h+    addUpdate (ReconciliationSummary a b c d e f g h) = ReconciliationSummary a (b + 1) c d e f g h+    addMerge (ReconciliationSummary a b c d e f g h) = ReconciliationSummary a b (c + 1) d e f g h+    addUnchanged (ReconciliationSummary a b c d e f g h) = ReconciliationSummary a b c (d + 1) e f g h+    addConflict (ReconciliationSummary a b c d e f g h) = ReconciliationSummary a b c d (e + 1) f g h+    addSafeDelete (ReconciliationSummary a b c d e f g h) = ReconciliationSummary a b c d e (f + 1) g h+    addEditedOrphan (ReconciliationSummary a b c d e f g h) = ReconciliationSummary a b c d e f (g + 1) h+    addSharedOwnership (ReconciliationSummary a b c d e f g h) = ReconciliationSummary a b c d e f g (h + 1)++replacePlanFiles :: ReconciliationPlan -> Map FilePath FileReconciliation -> ReconciliationPlan+replacePlanFiles plan newFiles =+  ReconciliationPlan+    { applicationIds = plan.applicationIds,+      files = newFiles,+      requiredDirectories = plan.requiredDirectories+    }++reconciliationMutationPaths :: ReconciliationPlan -> Set FilePath+reconciliationMutationPaths = Map.keysSet . (.files)++unresolvedPaths :: ReconciliationPlan -> Set FilePath+unresolvedPaths plan = Map.keysSet (Map.filter unresolved plan.files)+  where+    unresolved (FileConflict _ _ _ _ _ _ Nothing) = True+    unresolved (FileOrphanEdited _ _ _ _ Nothing) = True+    unresolved _ = False

@@ -0,0 +1,90 @@+module Seihou.Engine.ThreeWayMerge+  ( MergeOutcome (..),+    threeWayMerge,+    threeWayMergeWithGit,+  )+where++import Control.Exception (IOException, displayException, try)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Prelude+import System.Exit (ExitCode (..))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readProcessWithExitCode)++-- | The result of reconciling a previous generated ancestor, the user's+-- current file, and newly generated content. No outcome writes to the project.+data MergeOutcome+  = MergeClean Text+  | MergeConflicted Text+  | MergeUnavailable Text+  deriving stock (Eq, Show)++-- | Merge generated content in argument order: previous generated baseline,+-- current disk content, then new generated content.+threeWayMerge :: Text -> Text -> Text -> IO MergeOutcome+threeWayMerge = threeWayMergeWithGit "git"++-- | Testable driver variant. Production callers should use 'threeWayMerge';+-- supplying the executable keeps missing-driver behavior directly testable.+threeWayMergeWithGit :: FilePath -> Text -> Text -> Text -> IO MergeOutcome+threeWayMergeWithGit gitExecutable baseline current newGenerated+  | any (T.any (== '\NUL')) [baseline, current, newGenerated] =+      pure (MergeUnavailable "binary content containing NUL cannot be merged")+  | current == baseline = pure (MergeClean newGenerated)+  | newGenerated == baseline = pure (MergeClean current)+  | current == newGenerated = pure (MergeClean current)+  | otherwise = do+      result <-+        try @IOException $+          withSystemTempDirectory "seihou-three-way-merge" $ \tmpDir -> do+            let currentPath = tmpDir </> "CURRENT"+                baselinePath = tmpDir </> "BASE"+                newPath = tmpDir </> "NEW"+            TIO.writeFile currentPath current+            TIO.writeFile baselinePath baseline+            TIO.writeFile newPath newGenerated+            readProcessWithExitCode+              gitExecutable+              [ "merge-file",+                "--stdout",+                "--diff3",+                "-L",+                "current",+                "-L",+                "generated-base",+                "-L",+                "new-generated",+                currentPath,+                baselinePath,+                newPath+              ]+              ""+      pure $ case result of+        Left err -> MergeUnavailable ("git merge-file unavailable: " <> T.pack (displayException err))+        Right (ExitSuccess, stdout, _) -> MergeClean (T.pack stdout)+        Right (ExitFailure _, stdout, stderr)+          | hasCompleteConflictMarkers merged -> MergeConflicted merged+          | otherwise ->+              MergeUnavailable+                ( "git merge-file failed without a usable conflict result"+                    <> conciseStderr stderr+                )+          where+            merged = T.pack stdout++hasCompleteConflictMarkers :: Text -> Bool+hasCompleteConflictMarkers output =+  all+    (\marker -> any (marker `T.isPrefixOf`) (T.lines output))+    [ "<<<<<<< current",+      "||||||| generated-base",+      "=======",+      ">>>>>>> new-generated"+    ]++conciseStderr :: String -> Text+conciseStderr stderr = case T.strip (T.pack stderr) of+  "" -> ""+  message -> ": " <> T.take 240 message

@@ -0,0 +1,602 @@+module Seihou.Engine.UpdateTransaction+  ( UpdateTransaction (..),+    TransactionError (..),+    beginUpdateTransaction,+    applyReconciliation,+    applyReconciliationWithHook,+    rollbackUpdateTransaction,+    setUpdateTransactionExpectedManifest,+    completeUpdateTransaction,+    recoverIncompleteTransactions,+  )+where++import Control.Exception (SomeException, bracketOnError, displayException, onException, try)+import Control.Monad (foldM, forM, forM_, unless, when)+import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LBS+import Data.Foldable (traverse_)+import Data.List (sortOn)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Data.Time (UTCTime, getCurrentTime)+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types+import Seihou.Effect.BaselineStore (putBaseline)+import Seihou.Effect.BaselineStoreInterp (runBaselineStore)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Engine.Reconcile+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types (manifestFromJSON)+import Seihou.Prelude+import System.Directory qualified as Directory+import System.FilePath (splitDirectories, takeDirectory, takeFileName)+import System.IO (hClose, hSetEncoding, utf8)+import System.IO.Temp (createTempDirectory, openTempFile)++data UpdateTransaction = UpdateTransaction+  { projectRoot :: FilePath,+    transactionDirectory :: FilePath,+    targets :: Set FilePath+  }+  deriving stock (Eq, Show)++data TransactionError+  = InvalidTransactionPath FilePath Text+  | TransactionStartFailed Text+  | TransactionJournalMalformed FilePath Text+  | TransactionUnjournaledPaths (Set FilePath)+  | TransactionUnresolvedPaths (Set FilePath)+  | TransactionStalePlan FilePath ObservedFile ObservedFile+  | TransactionApplyFailed Text (Maybe Text)+  | TransactionRollbackFailed Text+  | TransactionCompletionFailed Text+  deriving stock (Eq, Show)++data JournalEntry = JournalEntry+  { targetPath :: FilePath,+    backupFile :: Maybe FilePath+  }+  deriving stock (Eq, Show)++data JournalMetadata = JournalMetadata+  { journalVersion :: Int,+    createdAt :: UTCTime,+    entries :: [JournalEntry],+    newDirectories :: [FilePath],+    expectedManifest :: Maybe Manifest+  }+  deriving stock (Eq, Show)++instance ToJSON JournalEntry where+  toJSON entry =+    Aeson.object+      [ "path" .= entry.targetPath,+        "backup" .= entry.backupFile+      ]++instance FromJSON JournalEntry where+  parseJSON = Aeson.withObject "JournalEntry" $ \object ->+    JournalEntry <$> object .: "path" <*> object .:? "backup"++instance ToJSON JournalMetadata where+  toJSON metadata =+    Aeson.object+      [ "version" .= metadata.journalVersion,+        "createdAt" .= metadata.createdAt,+        "entries" .= metadata.entries,+        "newDirectories" .= metadata.newDirectories,+        "expectedManifest" .= metadata.expectedManifest+      ]++instance FromJSON JournalMetadata where+  parseJSON = Aeson.withObject "JournalMetadata" $ \object -> do+    version <- object .: "version"+    unless (version == 1) (fail "unsupported transaction journal version")+    JournalMetadata+      <$> pure version+      <*> object .: "createdAt"+      <*> object .: "entries"+      <*> object .: "newDirectories"+      <*> object .:? "expectedManifest"++beginUpdateTransaction :: FilePath -> Set FilePath -> IO (Either TransactionError UpdateTransaction)+beginUpdateTransaction projectRoot targets = case traverse validateTransactionPath (Set.toAscList targets) of+  Left err -> pure (Left err)+  Right safeTargets -> do+    result <- try @SomeException $ do+      let transactionsRoot = projectRoot </> ".seihou" </> "transactions"+      Directory.createDirectoryIfMissing True transactionsRoot+      transactionDirectory <- createTempDirectory transactionsRoot "update-"+      let transaction = UpdateTransaction projectRoot transactionDirectory (Set.fromList safeTargets)+      initializeJournal transaction safeTargets `onException` cleanupDirectory transactionDirectory+      pure transaction+    pure $ first (TransactionStartFailed . exceptionText) result++initializeJournal :: UpdateTransaction -> [FilePath] -> IO ()+initializeJournal transaction safeTargets = do+  let backupDirectory = transaction.transactionDirectory </> "backups"+  Directory.createDirectoryIfMissing True backupDirectory+  entries <- forM (zip [0 :: Int ..] safeTargets) $ \(index, relativePath) -> do+    let fullPath = transaction.projectRoot </> relativePath+        backupName = show index <> ".txt"+        backupPath = backupDirectory </> backupName+    exists <- Directory.doesFileExist fullPath+    if exists+      then do+        TIO.readFile fullPath >>= TIO.writeFile backupPath+        pure (JournalEntry relativePath (Just backupName))+      else pure (JournalEntry relativePath Nothing)+  missingDirectories <- missingParentDirectories transaction.projectRoot safeTargets+  now <- getCurrentTime+  writeJournal+    transaction.transactionDirectory+    JournalMetadata+      { journalVersion = 1,+        createdAt = now,+        entries = entries,+        newDirectories = missingDirectories,+        expectedManifest = Nothing+      }++missingParentDirectories :: FilePath -> [FilePath] -> IO [FilePath]+missingParentDirectories projectRoot paths = do+  let candidates =+        Set.toAscList . Set.fromList . concatMap relativeParents $ paths+  missing <- filterMIO (fmap not . Directory.doesDirectoryExist . (projectRoot </>)) candidates+  pure (sortOn pathDepth missing)++relativeParents :: FilePath -> [FilePath]+relativeParents path =+  filter (/= ".") (takeWhile (/= ".") (iterate takeDirectory (takeDirectory path)))++applyReconciliation ::+  UpdateTransaction ->+  ReconciliationPlan ->+  Manifest ->+  IO (Either TransactionError Manifest)+applyReconciliation = applyReconciliationWithHook (const (pure ()))++-- | Hooked variant for deterministic failure-injection tests. The hook runs+-- after each successful disk write or deletion and receives a one-based count.+applyReconciliationWithHook ::+  (Int -> IO ()) ->+  UpdateTransaction ->+  ReconciliationPlan ->+  Manifest ->+  IO (Either TransactionError Manifest)+applyReconciliationWithHook afterMutation transaction plan manifest = do+  preflight <- transactionPreflight transaction plan+  case preflight of+    Left err -> failAndRollback transaction err+    Right () -> do+      prepared <- try @SomeException (prepareCandidateManifest transaction plan manifest)+      case prepared of+        Left err -> failAndRollback transaction (TransactionApplyFailed (exceptionText err) Nothing)+        Right candidate -> do+          journalResult <- updateJournalForPlan transaction plan candidate+          case journalResult of+            Left err -> failAndRollback transaction err+            Right () -> do+              mutationResult <- try @SomeException (applyMutations afterMutation transaction plan)+              case mutationResult of+                Left err ->+                  failAndRollback transaction (TransactionApplyFailed (exceptionText err) Nothing)+                Right () -> pure (Right candidate)++transactionPreflight :: UpdateTransaction -> ReconciliationPlan -> IO (Either TransactionError ())+transactionPreflight transaction plan = case traverse validateTransactionPath (Set.toAscList plan.requiredDirectories) of+  Left err -> pure (Left err)+  Right _+    | not (Set.null unjournaled) -> pure (Left (TransactionUnjournaledPaths unjournaled))+    | not (Set.null unresolved) -> pure (Left (TransactionUnresolvedPaths unresolved))+    | otherwise -> verifyObservedFiles transaction plan+  where+    unjournaled = Map.keysSet plan.files Set.\\ transaction.targets+    unresolved = unresolvedPaths plan++verifyObservedFiles :: UpdateTransaction -> ReconciliationPlan -> IO (Either TransactionError ())+verifyObservedFiles transaction plan = go (Map.toAscList plan.files)+  where+    go [] = pure (Right ())+    go ((path, reconciliation) : rest) = do+      current <- observeDiskFile (transaction.projectRoot </> path)+      let planned = reconciliationObservation reconciliation+      if current == planned+        then go rest+        else pure (Left (TransactionStalePlan path planned current))++reconciliationObservation :: FileReconciliation -> ObservedFile+reconciliationObservation reconciliation = case reconciliation of+  FileCreate _ _ observed -> observed+  FileUpdate _ _ observed _ -> observed+  FileAutoMerge _ _ observed _ -> observed+  FileUnchanged _ _ observed _ -> observed+  FileConflict _ _ _ _ observed _ _ -> observed+  FileDeleteSafe _ _ observed -> observed+  FileOrphanEdited _ _ _ observed _ -> observed+  FileReleaseSharedOwnership _ _ observed -> observed+  FileAlreadyAbsent _ _ observed -> observed++observeDiskFile :: FilePath -> IO ObservedFile+observeDiskFile path = do+  exists <- Directory.doesFileExist path+  if exists+    then do+      content <- TIO.readFile path+      pure (ObservedFile True (Just (hashContent content)))+    else pure (ObservedFile False Nothing)++prepareCandidateManifest :: UpdateTransaction -> ReconciliationPlan -> Manifest -> IO Manifest+prepareCandidateManifest transaction plan manifest = do+  nextFiles <- foldM applyManifestAction manifest.files (Map.toAscList plan.files)+  pure (replaceManifestFiles manifest nextFiles)+  where+    applyManifestAction files (path, reconciliation) = case desiredState reconciliation of+      Just (desired, state) -> do+        baseline <- writeBaselineBlob transaction.projectRoot state.generatedBaseline+        let record =+              FileRecord+                { hash = state.recordedHash,+                  moduleName = desired.moduleName,+                  strategy = desired.strategy,+                  generatedAt = manifest.genAt,+                  baseline = Just baseline,+                  applicationIds = desired.applicationIds+                }+        pure (Map.insert path record files)+      Nothing -> pure (applyOrphanManifestAction plan.applicationIds reconciliation files)++desiredState :: FileReconciliation -> Maybe (DesiredFile, PlannedFileState)+desiredState reconciliation = case reconciliation of+  FileCreate desired state _ -> Just (desired, state)+  FileUpdate desired state _ _ -> Just (desired, state)+  FileAutoMerge desired state _ _ -> Just (desired, state)+  FileUnchanged desired state _ _ -> Just (desired, state)+  FileConflict desired _ _ _ _ _ (Just resolution) -> Just (desired, resolution.state)+  _ -> Nothing++applyOrphanManifestAction ::+  Set ApplicationId ->+  FileReconciliation ->+  Map FilePath FileRecord ->+  Map FilePath FileRecord+applyOrphanManifestAction selected reconciliation files = case reconciliation of+  FileDeleteSafe path _ _ -> Map.delete path files+  FileAlreadyAbsent path _ _ -> Map.delete path files+  FileReleaseSharedOwnership path record _ ->+    let remaining = record.applicationIds Set.\\ selected+     in if Set.null remaining+          then Map.delete path files+          else Map.insert path (replaceRecordApplications record remaining) files+  FileOrphanEdited path _ _ _ (Just DeleteEditedOrphan) -> Map.delete path files+  FileOrphanEdited _ _ _ _ (Just RetainTrackedOrphan) -> files+  FileOrphanEdited path record _ _ (Just DetachAndKeepOrphan) ->+    let remaining = record.applicationIds Set.\\ selected+     in if Set.null remaining+          then Map.delete path files+          else Map.insert path (replaceRecordApplications record remaining) files+  _ -> files++replaceRecordApplications :: FileRecord -> Set ApplicationId -> FileRecord+replaceRecordApplications record owners =+  FileRecord+    { hash = record.hash,+      moduleName = record.moduleName,+      strategy = record.strategy,+      generatedAt = record.generatedAt,+      baseline = record.baseline,+      applicationIds = owners+    }++replaceManifestFiles :: Manifest -> Map FilePath FileRecord -> Manifest+replaceManifestFiles manifest nextFiles =+  Manifest+    { version = manifest.version,+      genAt = manifest.genAt,+      modules = manifest.modules,+      vars = manifest.vars,+      files = nextFiles,+      applications = manifest.applications,+      recipe = manifest.recipe,+      blueprint = manifest.blueprint,+      blueprintMigrations = manifest.blueprintMigrations+    }++writeBaselineBlob :: FilePath -> Text -> IO BaselineRef+writeBaselineBlob projectRoot content = do+  let baselineDirectory = projectRoot </> ".seihou" </> "baselines"+  runEff $ runFilesystem $ runBaselineStore baselineDirectory (putBaseline content)++updateJournalForPlan :: UpdateTransaction -> ReconciliationPlan -> Manifest -> IO (Either TransactionError ())+updateJournalForPlan transaction plan candidate = do+  metadataResult <- readJournal transaction.transactionDirectory+  case metadataResult of+    Left err -> pure (Left err)+    Right metadata -> do+      missingDirectories <-+        filterMIO+          (fmap not . Directory.doesDirectoryExist . (transaction.projectRoot </>))+          ( Set.toAscList . Set.fromList $+              concatMap+                (\path -> path : relativeParents path)+                (Set.toAscList plan.requiredDirectories)+          )+      let updated = setExpectedManifestAndDirectories metadata missingDirectories candidate+      result <- try @SomeException $ writeJournal transaction.transactionDirectory updated+      pure $ first (\err -> TransactionApplyFailed (exceptionText err) Nothing) result++setExpectedManifestAndDirectories :: JournalMetadata -> [FilePath] -> Manifest -> JournalMetadata+setExpectedManifestAndDirectories metadata additionalDirectories candidate =+  JournalMetadata+    { journalVersion = metadata.journalVersion,+      createdAt = metadata.createdAt,+      entries = metadata.entries,+      newDirectories =+        sortOn pathDepth . Set.toList $+          Set.fromList (metadata.newDirectories <> additionalDirectories),+      expectedManifest = Just candidate+    }++applyMutations :: (Int -> IO ()) -> UpdateTransaction -> ReconciliationPlan -> IO ()+applyMutations afterMutation transaction plan = do+  forM_ (Set.toAscList plan.requiredDirectories) $ \relativePath ->+    Directory.createDirectoryIfMissing True (transaction.projectRoot </> relativePath)+  _ <- foldM applyOne (0 :: Int) (Map.toAscList plan.files)+  pure ()+  where+    applyOne count (path, reconciliation) = case mutationFor reconciliation of+      NoMutation -> pure count+      WriteMutation content -> do+        atomicWriteText (transaction.projectRoot </> path) content+        let next = count + 1+        afterMutation next+        pure next+      DeleteMutation -> do+        let fullPath = transaction.projectRoot </> path+        exists <- Directory.doesFileExist fullPath+        when exists (Directory.removeFile fullPath)+        let next = count + 1+        afterMutation next+        pure next++data FileMutation = NoMutation | WriteMutation Text | DeleteMutation++mutationFor :: FileReconciliation -> FileMutation+mutationFor reconciliation = case desiredState reconciliation of+  Just (_, state)+    | state.writeToDisk -> WriteMutation state.appliedContent+    | otherwise -> NoMutation+  Nothing -> case reconciliation of+    FileDeleteSafe _ _ _ -> DeleteMutation+    FileOrphanEdited _ _ _ _ (Just DeleteEditedOrphan) -> DeleteMutation+    _ -> NoMutation++rollbackUpdateTransaction :: UpdateTransaction -> IO (Either TransactionError ())+rollbackUpdateTransaction transaction = do+  metadataResult <- readJournal transaction.transactionDirectory+  case metadataResult of+    Left err -> pure (Left err)+    Right metadata -> do+      result <- try @SomeException $ do+        forM_ metadata.entries (restoreEntry transaction)+        removeNewDirectories transaction.projectRoot metadata.newDirectories+        cleanupDirectory transaction.transactionDirectory+      pure $ first (TransactionRollbackFailed . exceptionText) result++restoreEntry :: UpdateTransaction -> JournalEntry -> IO ()+restoreEntry transaction entry = do+  let target = transaction.projectRoot </> entry.targetPath+  case entry.backupFile of+    Nothing -> do+      exists <- Directory.doesFileExist target+      when exists (Directory.removeFile target)+    Just backupName -> do+      let backupPath = transaction.transactionDirectory </> "backups" </> backupName+      content <- TIO.readFile backupPath+      atomicWriteText target content++removeNewDirectories :: FilePath -> [FilePath] -> IO ()+removeNewDirectories projectRoot = mapM_ removeIfEmpty . reverse . sortOn pathDepth+  where+    removeIfEmpty relativePath = do+      let fullPath = projectRoot </> relativePath+      exists <- Directory.doesDirectoryExist fullPath+      when exists $ do+        contents <- Directory.listDirectory fullPath+        when (null contents) (Directory.removeDirectory fullPath)++completeUpdateTransaction :: UpdateTransaction -> IO (Either TransactionError ())+completeUpdateTransaction transaction = do+  result <- try @SomeException (cleanupDirectory transaction.transactionDirectory)+  pure $ first (TransactionCompletionFailed . exceptionText) result++-- | Replace the recovery commit marker with the exact manifest the caller is+-- about to publish. Reconciliation initially records its files-only candidate;+-- orchestrators that add application/cache/receipt state must set the complete+-- candidate before the atomic manifest write.+setUpdateTransactionExpectedManifest :: UpdateTransaction -> Manifest -> IO (Either TransactionError ())+setUpdateTransactionExpectedManifest transaction expected = do+  metadataResult <- readJournal transaction.transactionDirectory+  case metadataResult of+    Left err -> pure (Left err)+    Right metadata -> do+      let updated =+            JournalMetadata+              { journalVersion = metadata.journalVersion,+                createdAt = metadata.createdAt,+                entries = metadata.entries,+                newDirectories = metadata.newDirectories,+                expectedManifest = Just expected+              }+      result <- try @SomeException (writeJournal transaction.transactionDirectory updated)+      pure $ first (\err -> TransactionApplyFailed (exceptionText err) Nothing) result++recoverIncompleteTransactions :: FilePath -> IO [Either TransactionError ()]+recoverIncompleteTransactions projectRoot = do+  let transactionsRoot = projectRoot </> ".seihou" </> "transactions"+  exists <- Directory.doesDirectoryExist transactionsRoot+  if not exists+    then pure []+    else do+      names <- Directory.listDirectory transactionsRoot+      directories <- filterMIO (Directory.doesDirectoryExist . (transactionsRoot </>)) names+      dated <- forM directories $ \name -> do+        modified <- Directory.getModificationTime (transactionsRoot </> name)+        pure (modified, name)+      forM (map snd (sortOn fst dated)) $ \name ->+        recoverOne projectRoot (transactionsRoot </> name)++recoverOne :: FilePath -> FilePath -> IO (Either TransactionError ())+recoverOne projectRoot transactionDirectory = do+  metadataResult <- readJournal transactionDirectory+  case metadataResult of+    Left err -> do+      quarantined <- quarantineTransaction projectRoot transactionDirectory+      pure $ case quarantined of+        Left quarantineError -> Left quarantineError+        Right () -> Left err+    Right metadata -> do+      committed <- manifestMatches projectRoot metadata.expectedManifest+      if committed+        then do+          result <- try @SomeException (cleanupDirectory transactionDirectory)+          pure $ first (TransactionCompletionFailed . exceptionText) result+        else+          rollbackUpdateTransaction+            UpdateTransaction+              { projectRoot = projectRoot,+                transactionDirectory = transactionDirectory,+                targets = Set.fromList (map (.targetPath) metadata.entries)+              }++manifestMatches :: FilePath -> Maybe Manifest -> IO Bool+manifestMatches _ Nothing = pure False+manifestMatches projectRoot (Just expected) = do+  let manifestPath = projectRoot </> ".seihou" </> "manifest.json"+  exists <- Directory.doesFileExist manifestPath+  if not exists+    then pure False+    else do+      bytes <- LBS.readFile manifestPath+      pure (manifestFromJSON bytes == Right expected)++quarantineTransaction :: FilePath -> FilePath -> IO (Either TransactionError ())+quarantineTransaction projectRoot transactionDirectory = do+  result <- try @SomeException $ do+    let quarantineRoot = projectRoot </> ".seihou" </> "transactions-quarantine"+        target = quarantineRoot </> takeFileName transactionDirectory+    Directory.createDirectoryIfMissing True quarantineRoot+    targetExists <- Directory.doesPathExist target+    when targetExists (ioError (userError ("quarantine target already exists: " <> target)))+    Directory.renamePath transactionDirectory target+  pure $ first (TransactionRollbackFailed . exceptionText) result++readJournal :: FilePath -> IO (Either TransactionError JournalMetadata)+readJournal transactionDirectory = do+  let path = journalPath transactionDirectory+  result <- try @SomeException (LBS.readFile path)+  pure $ case result of+    Left err -> Left (TransactionJournalMalformed path (exceptionText err))+    Right bytes -> case Aeson.eitherDecode bytes of+      Left err -> Left (TransactionJournalMalformed path (T.pack err))+      Right metadata -> first (TransactionJournalMalformed path) (validateJournal metadata)++validateJournal :: JournalMetadata -> Either Text JournalMetadata+validateJournal metadata = do+  traverse_ (validateJournalEntry . (.targetPath)) metadata.entries+  traverse_ validateBackupName [name | JournalEntry _ (Just name) <- metadata.entries]+  traverse_ (first renderTransactionPathError . validateTransactionPath) metadata.newDirectories+  pure metadata+  where+    validateJournalEntry path = first renderTransactionPathError (validateTransactionPath path)+    validateBackupName name+      | takeFileName name == name && name /= "." && name /= ".." = Right ()+      | otherwise = Left ("invalid backup filename: " <> T.pack name)++renderTransactionPathError :: TransactionError -> Text+renderTransactionPathError (InvalidTransactionPath path reason) = T.pack path <> ": " <> reason+renderTransactionPathError other = T.pack (show other)++writeJournal :: FilePath -> JournalMetadata -> IO ()+writeJournal transactionDirectory metadata = do+  let path = journalPath transactionDirectory+      tempPath = path <> ".tmp"+  LBS.writeFile tempPath (Aeson.encode metadata)+  Directory.renamePath tempPath path++journalPath :: FilePath -> FilePath+journalPath transactionDirectory = transactionDirectory </> "journal.json"++validateTransactionPath :: FilePath -> Either TransactionError FilePath+validateTransactionPath rawPath = case validateProjectRelativePath (T.pack rawPath) of+  Left err -> Left (InvalidTransactionPath rawPath err)+  Right safePath+    | safePath /= rawPath -> Left (InvalidTransactionPath rawPath "path must not contain surrounding whitespace")+    | safePath == "." -> Left (InvalidTransactionPath rawPath "path must name a project file")+    | targetsControlPath safePath ->+        Left (InvalidTransactionPath rawPath "path targets Seihou or Git control data")+    | otherwise -> Right safePath++targetsControlPath :: FilePath -> Bool+targetsControlPath path = case pathSegments path of+  firstSegment : _ -> firstSegment == ".seihou" || firstSegment == ".git"+  [] -> False++pathSegments :: FilePath -> [Text]+pathSegments = filter (not . T.null) . T.split (\character -> character == '/' || character == '\\') . T.pack++atomicWriteText :: FilePath -> Text -> IO ()+atomicWriteText path content = do+  let parent = takeDirectory path+  Directory.createDirectoryIfMissing True parent+  bracketOnError+    (openTempFile parent (takeFileName path <> ".seihou-update-"))+    (\(tempPath, handle) -> ignoreException (hClose handle) >> removeIfExists tempPath)+    ( \(tempPath, handle) -> do+        hSetEncoding handle utf8+        TIO.hPutStr handle content+        hClose handle+        Directory.renamePath tempPath path+    )++removeIfExists :: FilePath -> IO ()+removeIfExists path = do+  exists <- Directory.doesFileExist path+  when exists (Directory.removeFile path)++ignoreException :: IO () -> IO ()+ignoreException action = do+  _ <- try @SomeException action+  pure ()++cleanupDirectory :: FilePath -> IO ()+cleanupDirectory path = do+  exists <- Directory.doesDirectoryExist path+  when exists (Directory.removeDirectoryRecursive path)++failAndRollback :: UpdateTransaction -> TransactionError -> IO (Either TransactionError a)+failAndRollback transaction originalError = do+  rollback <- rollbackUpdateTransaction transaction+  pure $ case rollback of+    Right () -> Left originalError+    Left rollbackError ->+      Left+        ( TransactionApplyFailed+            (T.pack (show originalError))+            (Just (T.pack (show rollbackError)))+        )++filterMIO :: (a -> IO Bool) -> [a] -> IO [a]+filterMIO predicate values = fmap concat $ forM values $ \value -> do+  keep <- predicate value+  pure [value | keep]++pathDepth :: FilePath -> Int+pathDepth = length . splitDirectories++exceptionText :: SomeException -> Text+exceptionText = T.pack . displayException

@@ -1,13 +1,17 @@ module Seihou.Manifest.Hash   ( hashContent,+    baselineRefForContent,+    baselineRefFromText,   ) where  import Crypto.Hash.SHA256 qualified as SHA256 import Data.ByteString qualified as BS import Data.ByteString.Base16 qualified as Base16+import Data.Char (isHexDigit)+import Data.Text qualified as T import Data.Text.Encoding qualified as TE-import Seihou.Core.Types (SHA256 (..))+import Seihou.Core.Types (BaselineRef (..), SHA256 (..)) import Seihou.Prelude  -- | Compute the SHA256 hash of text content, returning a hex-encoded digest.@@ -18,3 +22,16 @@       digest = SHA256.hash bytes       hex = Base16.encode digest    in SHA256 (TE.decodeUtf8 hex)++-- | Hash generated content into its content-addressed baseline reference.+baselineRefForContent :: Text -> BaselineRef+baselineRefForContent = BaselineRef . hashContent++-- | Validate and normalize a serialized SHA-256 baseline reference. SHA-256+-- references are exactly 64 hexadecimal digits; normalization keeps on-disk+-- filenames canonical even when an older hand-written manifest used uppercase.+baselineRefFromText :: Text -> Maybe BaselineRef+baselineRefFromText value+  | T.length value == 64 && T.all isHexDigit value =+      Just (BaselineRef (SHA256 (T.toLower value)))+  | otherwise = Nothing

@@ -4,6 +4,8 @@     manifestToJSON,     manifestFromJSON,     writeAppliedBlueprint,+    writeAppliedBlueprintMigration,+    hasAppliedBlueprintMigration,   ) where @@ -12,9 +14,11 @@ import Data.Aeson.Types qualified as Aeson import Data.ByteString.Lazy qualified as LBS import Data.Map.Strict qualified as Map+import Data.Set qualified as Set import Data.Text qualified as T import Data.Time (UTCTime) import Seihou.Core.Types+import Seihou.Manifest.Hash (baselineRefFromText) import Seihou.Prelude hiding ((.=))  -- | Current manifest schema version.@@ -28,8 +32,16 @@ -- field (see docs/plans/32-blueprint-manifest-and-status.md). -- Schema-2 manifests remain readable because the decoder treats a -- missing @blueprint@ key as 'Nothing'.+--+-- Bumped from 3 to 4 when 'Manifest' gained reproducible applications+-- and 'FileRecord' gained generated-baseline and application ownership.+-- Older manifests remain readable because every new field has an empty+-- or absent default.+--+-- Bumped from 4 to 5 when 'Manifest' gained the durable+-- @blueprintMigrations@ receipt ledger. A missing ledger decodes as empty. currentManifestVersion :: Int-currentManifestVersion = 3+currentManifestVersion = 5  -- | Create an empty manifest with the given timestamp. emptyManifest :: UTCTime -> Manifest@@ -40,8 +52,10 @@       modules = [],       vars = Map.empty,       files = Map.empty,+      applications = [],       recipe = Nothing,-      blueprint = Nothing+      blueprint = Nothing,+      blueprintMigrations = []     }  -- | Record an applied-blueprint provenance on a manifest, replacing any@@ -56,10 +70,49 @@       modules = m.modules,       vars = m.vars,       files = m.files,+      applications = m.applications,       recipe = m.recipe,-      blueprint = Just ab+      blueprint = Just ab,+      blueprintMigrations = m.blueprintMigrations     } +-- | Insert or replace one exact blueprint migration receipt. Replacement is+-- performed in place, while adding a v5-only receipt upgrades the manifest+-- version and preserves every unrelated field.+writeAppliedBlueprintMigration :: AppliedBlueprintMigration -> Manifest -> Manifest+writeAppliedBlueprintMigration receipt manifest =+  Manifest+    { version = currentManifestVersion,+      genAt = manifest.genAt,+      modules = manifest.modules,+      vars = manifest.vars,+      files = manifest.files,+      applications = manifest.applications,+      recipe = manifest.recipe,+      blueprint = manifest.blueprint,+      blueprintMigrations = upsert manifest.blueprintMigrations+    }+  where+    sameEdge existing =+      existing.name == receipt.name+        && existing.fromVersion == receipt.fromVersion+        && existing.toVersion == receipt.toVersion++    upsert receipts+      | any sameEdge receipts = map (\existing -> if sameEdge existing then receipt else existing) receipts+      | otherwise = receipts <> [receipt]++-- | Whether one exact blueprint migration edge already has a receipt.+hasAppliedBlueprintMigration :: ModuleName -> Text -> Text -> Manifest -> Bool+hasAppliedBlueprintMigration blueprintName fromVersion toVersion manifest =+  any+    ( \receipt ->+        receipt.name == blueprintName+          && receipt.fromVersion == fromVersion+          && receipt.toVersion == toVersion+    )+    manifest.blueprintMigrations+ -- | Encode a manifest to JSON bytes. manifestToJSON :: Manifest -> LBS.ByteString manifestToJSON = Aeson.encode@@ -77,7 +130,9 @@         "generatedAt" .= m.genAt,         "modules" .= m.modules,         "variables" .= varsToJSON m.vars,-        "files" .= filesToJSON m.files+        "files" .= filesToJSON m.files,+        "applications" .= m.applications,+        "blueprintMigrations" .= m.blueprintMigrations       ]         ++ maybe [] (\r -> ["recipe" .= r]) m.recipe         ++ maybe [] (\b -> ["blueprint" .= b]) m.blueprint@@ -88,14 +143,111 @@     if v > currentManifestVersion       then fail "manifest was created by a newer version of seihou"       else-        Manifest v-          <$> o .: "generatedAt"+        Manifest+          <$> pure v+          <*> o .: "generatedAt"           <*> o .: "modules"           <*> (varsFromJSON =<< o .: "variables")           <*> (filesFromJSON =<< o .: "files")+          <*> o Aeson..:? "applications" Aeson..!= []           <*> o Aeson..:? "recipe"           <*> o Aeson..:? "blueprint"+          <*> o Aeson..:? "blueprintMigrations" Aeson..!= [] +instance ToJSON AppliedTarget where+  toJSON (AppliedModuleTarget name) =+    Aeson.object ["kind" .= ("module" :: Text), "name" .= name.unModuleName]+  toJSON (AppliedRecipeTarget name) =+    Aeson.object ["kind" .= ("recipe" :: Text), "name" .= name.unRecipeName]++instance FromJSON AppliedTarget where+  parseJSON = Aeson.withObject "AppliedTarget" $ \o -> do+    kind <- o .: "kind" :: Aeson.Parser Text+    name <- o .: "name"+    case kind of+      "module" -> pure (AppliedModuleTarget (ModuleName name))+      "recipe" -> pure (AppliedRecipeTarget (RecipeName name))+      other -> fail ("unknown applied target kind: " <> T.unpack other)++instance ToJSON AppliedInstanceState where+  toJSON state =+    Aeson.object $+      [ "name" .= state.name.unModuleName,+        "source" .= state.source,+        "resolvedVars" .= varsToJSON state.resolvedVars+      ]+        ++ parentVarsField state.parentVars+        ++ maybe [] (\v -> ["version" .= v]) state.moduleVersion+    where+      parentVarsField (ParentVars m)+        | Map.null m = []+        | otherwise = ["parentVars" .= parentVarsMapToJSON m]++instance FromJSON AppliedInstanceState where+  parseJSON = Aeson.withObject "AppliedInstanceState" $ \o -> do+    mParentVars <- o Aeson..:? "parentVars"+    pv <- case mParentVars of+      Nothing -> pure emptyParentVars+      Just value -> ParentVars <$> parentVarsMapFromJSON value+    AppliedInstanceState+      <$> (ModuleName <$> o .: "name")+      <*> pure pv+      <*> o .: "source"+      <*> o Aeson..:? "version"+      <*> (varsFromJSON =<< o Aeson..:? "resolvedVars" Aeson..!= Aeson.object [])++instance ToJSON AppliedComposition where+  toJSON composition =+    Aeson.object $+      [ "applicationId" .= composition.applicationId.unApplicationId,+        "target" .= composition.target,+        "targetSource" .= composition.targetSource,+        "additionalModules" .= map (.unModuleName) composition.additionalModules,+        "instances" .= composition.instances,+        "appliedAt" .= composition.appliedAt+      ]+        ++ maybe [] (\v -> ["targetVersion" .= v]) composition.targetVersion+        ++ maybe [] (\v -> ["namespace" .= v]) composition.namespace+        ++ maybe [] (\v -> ["context" .= v]) composition.context+        ++ commandReceiptsField composition.commandReceipts+    where+      commandReceiptsField receipts+        | Map.null receipts = []+        | otherwise = ["commandReceipts" .= commandReceiptsToJSON receipts]++instance FromJSON AppliedComposition where+  parseJSON = Aeson.withObject "AppliedComposition" $ \o ->+    AppliedComposition+      <$> (ApplicationId <$> o .: "applicationId")+      <*> o .: "target"+      <*> o .: "targetSource"+      <*> o Aeson..:? "targetVersion"+      <*> (map ModuleName <$> o Aeson..:? "additionalModules" Aeson..!= [])+      <*> o Aeson..:? "namespace"+      <*> o Aeson..:? "context"+      <*> o Aeson..:? "instances" Aeson..!= []+      <*> (commandReceiptsFromJSON =<< o Aeson..:? "commandReceipts" Aeson..!= Aeson.object [])+      <*> o .: "appliedAt"++instance ToJSON CommandReceipt where+  toJSON receipt =+    Aeson.object $+      [ "fingerprint" .= commandFingerprintText receipt.fingerprint,+        "module" .= receipt.moduleName.unModuleName,+        "command" .= receipt.command,+        "completedAt" .= receipt.completedAt+      ]+        ++ maybe [] (\path -> ["workDir" .= path]) receipt.workDir++instance FromJSON CommandReceipt where+  parseJSON = Aeson.withObject "CommandReceipt" $ \o ->+    CommandReceipt+      <$> (CommandFingerprint . SHA256 <$> o .: "fingerprint")+      <*> (ModuleName <$> o .: "module")+      <*> o .: "command"+      <*> o Aeson..:? "workDir"+      <*> o .: "completedAt"+ instance ToJSON AppliedRecipe where   toJSON ar =     Aeson.object $@@ -134,6 +286,27 @@       <*> o Aeson..:? "userPrompt"       <*> o Aeson..:? "agentSessionId" +instance ToJSON AppliedBlueprintMigration where+  toJSON receipt =+    Aeson.object $+      [ "name" .= receipt.name.unModuleName,+        "from" .= receipt.fromVersion,+        "to" .= receipt.toVersion,+        "appliedAt" .= receipt.appliedAt+      ]+        ++ maybe [] (\version -> ["version" .= version]) receipt.blueprintVersion+        ++ maybe [] (\sessionId -> ["agentSessionId" .= sessionId]) receipt.agentSessionId++instance FromJSON AppliedBlueprintMigration where+  parseJSON = Aeson.withObject "AppliedBlueprintMigration" $ \o ->+    AppliedBlueprintMigration+      <$> (ModuleName <$> o .: "name")+      <*> o Aeson..:? "version"+      <*> o .: "from"+      <*> o .: "to"+      <*> o .: "appliedAt"+      <*> o Aeson..:? "agentSessionId"+ instance ToJSON AppliedModule where   toJSON am =     Aeson.object $@@ -237,26 +410,51 @@  instance ToJSON FileRecord where   toJSON fr =-    Aeson.object+    Aeson.object $       [ "hash" .= fr.hash.unSHA256,         "module" .= fr.moduleName.unModuleName,         "strategy" .= strategyToText fr.strategy,         "generatedAt" .= fr.generatedAt       ]+        ++ maybe [] (\ref -> ["baseline" .= ref.unBaselineRef.unSHA256]) fr.baseline+        ++ applicationIdsField fr.applicationIds+    where+      applicationIdsField ids+        | Set.null ids = []+        | otherwise = ["applications" .= map (.unApplicationId) (Set.toAscList ids)]  instance FromJSON FileRecord where-  parseJSON = Aeson.withObject "FileRecord" $ \o ->+  parseJSON = Aeson.withObject "FileRecord" $ \o -> do+    baselineText <- o Aeson..:? "baseline"+    baseline <- traverse parseBaselineRef baselineText     FileRecord       <$> (SHA256 <$> o .: "hash")       <*> (ModuleName <$> o .: "module")       <*> (strategyFromText =<< o .: "strategy")       <*> o .: "generatedAt"+      <*> pure baseline+      <*> (Set.fromList . map ApplicationId <$> o Aeson..:? "applications" Aeson..!= [])+    where+      parseBaselineRef value = case baselineRefFromText value of+        Just ref -> pure ref+        Nothing -> fail "baseline must be a 64-character hexadecimal SHA-256 digest"  instance ToJSON SHA256 where   toJSON (SHA256 t) = toJSON t  instance FromJSON SHA256 where   parseJSON v = SHA256 <$> parseJSON v++commandFingerprintText :: CommandFingerprint -> Text+commandFingerprintText (CommandFingerprint (SHA256 value)) = value++commandReceiptsToJSON :: Map CommandFingerprint CommandReceipt -> Aeson.Value+commandReceiptsToJSON = toJSON . Map.mapKeys commandFingerprintText++commandReceiptsFromJSON :: Aeson.Value -> Aeson.Parser (Map CommandFingerprint CommandReceipt)+commandReceiptsFromJSON value = do+  receipts <- parseJSON value :: Aeson.Parser (Map Text CommandReceipt)+  pure (Map.mapKeys (CommandFingerprint . SHA256) receipts)  -- Helpers for VarName-keyed maps 

@@ -6,7 +6,9 @@ import Seihou.Composition.RecipeSpec qualified as CompositionRecipeSpec import Seihou.Composition.ResolveSpec qualified as ResolveSpec import Seihou.Core.AgentPromptSpec qualified as AgentPromptSpec+import Seihou.Core.ApplicationSpec qualified as ApplicationSpec import Seihou.Core.BlueprintSpec qualified as BlueprintSpec+import Seihou.Core.CommandFingerprintSpec qualified as CommandFingerprintSpec import Seihou.Core.CommandVarSpec qualified as CommandVarSpec import Seihou.Core.ContextSpec qualified as ContextSpec import Seihou.Core.ExprSpec qualified as ExprSpec@@ -27,20 +29,25 @@ import Seihou.Dhall.ConfigSpec qualified as ConfigSpec import Seihou.Dhall.EvalSpec qualified as DhallEvalSpec import Seihou.Dhall.MigrationDecoderSpec qualified as MigrationDecoderSpec+import Seihou.Effect.BaselineStoreSpec qualified as BaselineStoreSpec import Seihou.Effect.ConfigReaderSpec qualified as ConfigReaderSpec import Seihou.Effect.ConfigWriterSpec qualified as ConfigWriterSpec import Seihou.Effect.FilesystemSpec qualified as FilesystemSpec import Seihou.Effect.LoggerSpec qualified as LoggerSpec import Seihou.Effect.ManifestStoreSpec qualified as ManifestStoreSpec+import Seihou.Engine.BaselineSpec qualified as BaselineSpec import Seihou.Engine.ConflictSpec qualified as ConflictSpec import Seihou.Engine.DiffSpec qualified as DiffSpec import Seihou.Engine.ExecuteSpec qualified as ExecuteSpec import Seihou.Engine.MigrateSpec qualified as EngineMigrateSpec import Seihou.Engine.PlanSpec qualified as PlanSpec import Seihou.Engine.PreviewSpec qualified as PreviewSpec+import Seihou.Engine.ReconcileSpec qualified as ReconcileSpec import Seihou.Engine.RemoveSpec qualified as RemoveSpec import Seihou.Engine.SectionSpec qualified as SectionSpec import Seihou.Engine.TemplateSpec qualified as TemplateSpec+import Seihou.Engine.ThreeWayMergeSpec qualified as ThreeWayMergeSpec+import Seihou.Engine.UpdateTransactionSpec qualified as UpdateTransactionSpec import Seihou.Engine.ValidateSpec qualified as ValidateSpec import Seihou.Evaluation.ConditionalTemplateSpec qualified as ConditionalTemplateSpec import Seihou.Evaluation.DhallTextFlakeSpec qualified as DhallTextFlakeSpec@@ -63,7 +70,9 @@   compositionRecipeTests <- CompositionRecipeSpec.tests   resolveTests <- ResolveSpec.tests   agentPromptTests <- AgentPromptSpec.tests+  applicationTests <- ApplicationSpec.tests   blueprintTests <- BlueprintSpec.tests+  commandFingerprintTests <- CommandFingerprintSpec.tests   commandVarTests <- CommandVarSpec.tests   typesTests <- TypesSpec.tests   contextTests <- ContextSpec.tests@@ -82,8 +91,11 @@   variableTests <- VariableSpec.tests   versionTests <- VersionSpec.tests   templateTests <- TemplateSpec.tests+  threeWayMergeTests <- ThreeWayMergeSpec.tests+  updateTransactionTests <- UpdateTransactionSpec.tests   planTests <- PlanSpec.tests   previewTests <- PreviewSpec.tests+  reconcileTests <- ReconcileSpec.tests   sectionTests <- SectionSpec.tests   validateTests <- ValidateSpec.tests   splitFlakeTests <- SplitFlakeSpec.tests@@ -95,10 +107,12 @@   migrationDecoderTests <- MigrationDecoderSpec.tests   configReaderTests <- ConfigReaderSpec.tests   configWriterTests <- ConfigWriterSpec.tests+  baselineStoreTests <- BaselineStoreSpec.tests   filesystemTests <- FilesystemSpec.tests   loggerTests <- LoggerSpec.tests   manifestStoreTests <- ManifestStoreSpec.tests   conflictTests <- ConflictSpec.tests+  baselineTests <- BaselineSpec.tests   diffTests <- DiffSpec.tests   executeTests <- ExecuteSpec.tests   engineMigrateTests <- EngineMigrateSpec.tests@@ -110,4 +124,4 @@   manifestTypesTests <- ManifestTypesSpec.tests   promptTests <- PromptSpec.tests   confirmTests <- ConfirmSpec.tests-  defaultMain (testGroup "seihou-core" [graphTests, instanceTests, compositionPlanTests, compositionRecipeTests, resolveTests, agentPromptTests, blueprintTests, commandVarTests, typesTests, contextTests, exprTests, installTests, listTests, migrationTests, moduleTests, recipeTests, registryTests, registryEmitTests, registrySyncTests, scaffoldTests, schemaUpgradeTests, statusTests, variableTests, versionTests, templateTests, planTests, previewTests, sectionTests, validateTests, splitFlakeTests, dhallTextFlakeTests, typedDhallTextTests, conditionalTemplateTests, configTests, dhallEvalTests, migrationDecoderTests, configReaderTests, configWriterTests, filesystemTests, loggerTests, manifestStoreTests, conflictTests, diffTests, executeTests, engineMigrateTests, removeTests, compositionTests, executionTests, integrationTests, generationTests, manifestTypesTests, promptTests, confirmTests])+  defaultMain (testGroup "seihou-core" [graphTests, instanceTests, compositionPlanTests, compositionRecipeTests, resolveTests, agentPromptTests, applicationTests, blueprintTests, commandFingerprintTests, commandVarTests, typesTests, contextTests, exprTests, installTests, listTests, migrationTests, moduleTests, recipeTests, registryTests, registryEmitTests, registrySyncTests, scaffoldTests, schemaUpgradeTests, statusTests, variableTests, versionTests, templateTests, threeWayMergeTests, updateTransactionTests, planTests, previewTests, reconcileTests, sectionTests, validateTests, splitFlakeTests, dhallTextFlakeTests, typedDhallTextTests, conditionalTemplateTests, configTests, dhallEvalTests, migrationDecoderTests, configReaderTests, configWriterTests, baselineStoreTests, filesystemTests, loggerTests, manifestStoreTests, conflictTests, baselineTests, diffTests, executeTests, engineMigrateTests, removeTests, compositionTests, executionTests, integrationTests, generationTests, manifestTypesTests, promptTests, confirmTests])

@@ -46,8 +46,8 @@       warnings `shouldBe` []      it "keeps all RunCommandOp operations" $ do-      let aOps = [RunCommandOp "echo hello" Nothing]-          bOps = [RunCommandOp "echo world" Nothing]+      let aOps = [RunCommandOp "echo hello" Nothing "module-a" 0]+          bOps = [RunCommandOp "echo world" Nothing "module-b" 0]           (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]       length ops `shouldBe` 2       warnings `shouldBe` []

@@ -110,6 +110,60 @@           let baseVars = byName "base" result           (.value) (baseVars Map.! "project.name") `shouldBe` VText "default" +    it "reuses saved instance values below CLI and above ambient sources" $ do+      let m = mkModule "base" [] [mkTextVar "project.name" (Just (VText "new-default")) False] []+          instanceId = primaryInstance "base"+          modules = [(instanceId, m, "/fake/base")]+          saved = Map.singleton instanceId (Map.singleton "project.name" "accepted")+          env = Map.singleton "SEIHOU_VAR_PROJECT_NAME" "ambient"+      case resolveComposedVariablesWithSaved modules saved Map.empty env "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let resolved = result Map.! instanceId Map.! "project.name"+          resolved.value `shouldBe` VText "accepted"+          resolved.source `shouldBe` FromApplication+      case resolveComposedVariablesWithSaved modules saved (Map.singleton "project.name" "explicit") env "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> (result Map.! instanceId Map.! "project.name").source `shouldBe` FromCLI++    it "re-coerces saved values through changed candidate declarations" $ do+      let countDecl =+            VarDecl+              { name = "project.count",+                type_ = VTInt,+                default_ = Nothing,+                description = Nothing,+                required = True,+                validation = Nothing+              }+          modul = mkModule "base" [] [countDecl] []+          instanceId = primaryInstance "base"+          saved = Map.singleton instanceId (Map.singleton "project.count" "not-an-int")+      resolveComposedVariablesWithSaved [(instanceId, modul, "/fake/base")] saved Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+        `shouldBe` Left [CoercionFailed "project.count" VTInt "not-an-int"]++    it "drops removed saved keys while new declarations resolve normally" $ do+      let modul =+            mkModule+              "base"+              []+              [ mkTextVar "project.kept" Nothing True,+                mkTextVar "project.new" (Just (VText "new-default")) False+              ]+              []+          instanceId = primaryInstance "base"+          saved =+            Map.singleton+              instanceId+              (Map.fromList [("project.kept", "accepted"), ("project.removed", "old")])+      case resolveComposedVariablesWithSaved [(instanceId, modul, "/fake/base")] saved Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let resolved = result Map.! instanceId+          Map.keys resolved `shouldBe` ["project.kept", "project.new"]+          (resolved Map.! "project.kept").source `shouldBe` FromApplication+          (resolved Map.! "project.new").source `shouldBe` FromDefault+     it "flows exported variable from dependency to dependent" $ do       let base = mkModule "base" [] [mkTextVar "project.name" (Just (VText "my-app")) False] [mkExport "project.name"]           app = mkModule "app" ["base"] [mkTextVar "project.name" Nothing True] []

@@ -0,0 +1,160 @@+module Seihou.Core.ApplicationSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Seihou.Composition.Instance (ModuleInstance (..))+import Seihou.Core.Application+import Seihou.Core.Types+import Seihou.Manifest.Hash (hashContent)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Application" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-19T10:30:00Z"++moduleTarget :: AppliedTarget+moduleTarget = AppliedModuleTarget (ModuleName "master-plan")++mkModule :: ModuleName -> Maybe Text -> Module+mkModule name version =+  Module+    { name = name,+      version = version,+      description = Nothing,+      vars = [],+      exports = [],+      prompts = [],+      steps = [],+      commands = [],+      dependencies = [],+      removal = Nothing,+      migrations = []+    }++mkResolved :: VarName -> VarValue -> ResolvedVar+mkResolved name value =+  ResolvedVar+    { value = value,+      source = FromDefault,+      decl =+        VarDecl+          { name = name,+            type_ = VTText,+            default_ = Nothing,+            description = Nothing,+            required = False,+            validation = Nothing+          }+    }++mkComposition :: AppliedTarget -> [ModuleName] -> AppliedComposition+mkComposition target additional =+  AppliedComposition+    { applicationId = mkApplicationId target additional,+      target = target,+      targetSource = "/modules/root",+      targetVersion = Just "1.0.0",+      additionalModules = additional,+      namespace = Just "root",+      context = Nothing,+      instances = [],+      commandReceipts = Map.empty,+      appliedAt = fixedTime+    }++spec :: Spec+spec = do+  describe "mkApplicationId" $ do+    it "is deterministic and uses the full SHA-256 digest" $ do+      let first = mkApplicationId moduleTarget [ModuleName "docs"]+          second = mkApplicationId moduleTarget [ModuleName "docs"]+      first `shouldBe` second+      T.length first.unApplicationId `shouldBe` 64++    it "changes when additional-root order changes" $ do+      let first = mkApplicationId moduleTarget [ModuleName "a", ModuleName "b"]+          second = mkApplicationId moduleTarget [ModuleName "b", ModuleName "a"]+      first `shouldNotBe` second++    it "distinguishes a module target from a recipe target with the same name" $ do+      mkApplicationId (AppliedModuleTarget "shared") []+        `shouldNotBe` mkApplicationId (AppliedRecipeTarget "shared") []++  describe "buildAppliedComposition" $ do+    it "keeps separately-scoped values for two instances of the same module" $ do+      let moduleName = ModuleName "link-skill"+          pv1 = ParentVars (Map.singleton (VarName "skill.name") "exec-plan")+          pv2 = ParentVars (Map.singleton (VarName "skill.name") "master-plan")+          inst1 = ModuleInstance moduleName pv1+          inst2 = ModuleInstance moduleName pv2+          modul = mkModule moduleName (Just "0.7.0")+          modulesInOrder = [(inst1, modul, "/modules/link-skill"), (inst2, modul, "/modules/link-skill")]+          resolved =+            Map.fromList+              [ (inst1, Map.singleton (VarName "skill.name") (mkResolved "skill.name" (VText "exec-plan"))),+                (inst2, Map.singleton (VarName "skill.name") (mkResolved "skill.name" (VText "master-plan")))+              ]+          composition =+            buildAppliedComposition moduleTarget "/modules/master-plan" (Just "0.7.0") [] (Just "docs") Nothing modulesInOrder resolved fixedTime+      map (.parentVars) composition.instances `shouldBe` [pv1, pv2]+      map (.resolvedVars) composition.instances+        `shouldBe` [Map.singleton "skill.name" "exec-plan", Map.singleton "skill.name" "master-plan"]++    it "keeps identity independent of versions, source paths, and resolved values" $ do+      let inst = ModuleInstance "dep" emptyParentVars+          first =+            buildAppliedComposition+              moduleTarget+              "/old/root"+              (Just "1.0.0")+              ["extra"]+              Nothing+              Nothing+              [(inst, mkModule "dep" (Just "1.0.0"), "/old/dep")]+              (Map.singleton inst (Map.singleton "value" (mkResolved "value" (VText "old"))))+              fixedTime+          second =+            buildAppliedComposition+              moduleTarget+              "/new/root"+              (Just "2.0.0")+              ["extra"]+              Nothing+              Nothing+              [(inst, mkModule "dep" (Just "2.0.0"), "/new/dep")]+              (Map.singleton inst (Map.singleton "value" (mkResolved "value" (VText "new"))))+              fixedTime+      first.applicationId `shouldBe` second.applicationId++    it "preserves the original module or recipe target" $ do+      let moduleComposition = buildAppliedComposition moduleTarget "/module" Nothing [] Nothing Nothing [] Map.empty fixedTime+          recipeTarget = AppliedRecipeTarget "service"+          recipeComposition = buildAppliedComposition recipeTarget "/recipe" (Just "2") [] Nothing Nothing [] Map.empty fixedTime+      moduleComposition.target `shouldBe` moduleTarget+      recipeComposition.target `shouldBe` recipeTarget++  describe "replaceAppliedComposition" $ do+    it "replaces in place and appends new applications" $ do+      let first = mkComposition moduleTarget []+          second = mkComposition (AppliedModuleTarget "other") []+          replacement = first {targetVersion = Just "2.0.0"}+          third = mkComposition (AppliedRecipeTarget "third") []+      replaceAppliedComposition replacement [first, second] `shouldBe` [replacement, second]+      replaceAppliedComposition third [first, second] `shouldBe` [first, second, third]++  describe "attachApplication" $ do+    it "unions prior and current ownership and preserves the generated baseline" $ do+      let priorId = ApplicationId "prior"+          currentId = ApplicationId "current"+          prior = FileRecord (hashContent "old") "module" Template fixedTime Nothing (Set.singleton priorId)+          current = FileRecord (hashContent "new") "module" Template fixedTime (Just (BaselineRef (hashContent "generated"))) Set.empty+          attached = attachApplication currentId (Just prior) current+      attached.applicationIds `shouldBe` Set.fromList [priorId, currentId]+      attached.baseline `shouldBe` Just (BaselineRef (hashContent "generated"))

@@ -2,7 +2,8 @@  import Data.Map.Strict qualified as Map import Data.Text qualified as T-import Seihou.Core.Blueprint (validateBlueprintWith)+import Seihou.Core.Blueprint (checkBlueprintMigrations, validateBlueprintWith)+import Seihou.Core.Migration (BlueprintMigration (..)) import Seihou.Core.Module (discoverRunnable) import Seihou.Core.Types import Seihou.Dhall.Eval (evalBlueprintFromFile)@@ -44,6 +45,7 @@     []     Nothing     []+    []  -- | Helpers to update individual 'Blueprint' fields without ambiguous -- record updates. Several @Blueprint@ fields collide by name with@@ -51,40 +53,44 @@ -- the ambiguity once and for all. withBlueprintName :: ModuleName -> Blueprint -> Blueprint withBlueprintName n b =-  Blueprint n b.version b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools b.tags+  Blueprint n b.version b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools b.tags b.migrations  withBlueprintVersion :: Maybe T.Text -> Blueprint -> Blueprint withBlueprintVersion v b =-  Blueprint b.name v b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools b.tags+  Blueprint b.name v b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools b.tags b.migrations  withBlueprintPrompt :: T.Text -> Blueprint -> Blueprint withBlueprintPrompt p b =-  Blueprint b.name b.version b.description p b.vars b.prompts b.baseModules b.files b.allowedTools b.tags+  Blueprint b.name b.version b.description p b.vars b.prompts b.baseModules b.files b.allowedTools b.tags b.migrations  withBlueprintVars :: [VarDecl] -> Blueprint -> Blueprint withBlueprintVars vs b =-  Blueprint b.name b.version b.description b.prompt vs b.prompts b.baseModules b.files b.allowedTools b.tags+  Blueprint b.name b.version b.description b.prompt vs b.prompts b.baseModules b.files b.allowedTools b.tags b.migrations  withBlueprintPrompts :: [Prompt] -> Blueprint -> Blueprint withBlueprintPrompts ps b =-  Blueprint b.name b.version b.description b.prompt b.vars ps b.baseModules b.files b.allowedTools b.tags+  Blueprint b.name b.version b.description b.prompt b.vars ps b.baseModules b.files b.allowedTools b.tags b.migrations  withBlueprintBaseModules :: [Dependency] -> Blueprint -> Blueprint withBlueprintBaseModules ds b =-  Blueprint b.name b.version b.description b.prompt b.vars b.prompts ds b.files b.allowedTools b.tags+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts ds b.files b.allowedTools b.tags b.migrations  withBlueprintFiles :: [BlueprintFile] -> Blueprint -> Blueprint withBlueprintFiles fs b =-  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules fs b.allowedTools b.tags+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules fs b.allowedTools b.tags b.migrations  withBlueprintAllowedTools :: Maybe [T.Text] -> Blueprint -> Blueprint withBlueprintAllowedTools at b =-  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules b.files at b.tags+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules b.files at b.tags b.migrations  withBlueprintTags :: [T.Text] -> Blueprint -> Blueprint withBlueprintTags ts b =-  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools ts+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools ts b.migrations +withBlueprintMigrations :: [BlueprintMigration] -> Blueprint -> Blueprint+withBlueprintMigrations migrations b =+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools b.tags migrations+ spec :: Spec spec = do   describe "evalBlueprintFromFile (sample fixture)" $ do@@ -101,7 +107,24 @@           b.tags `shouldBe` ["demo"]           b.baseModules `shouldBe` []           length b.files `shouldBe` 1+          b.migrations+            `shouldBe` [ BlueprintMigration "1.0.0" "2.0.0" "Update {{project.name}} for the first library release.",+                         BlueprintMigration "2.5.0" "3.0.0" "Update {{project.name}} for the second library release."+                       ] +    it "decodes declared blueprint migrations in declaration order" $ do+      withSystemTempDirectory "seihou-blueprint-migration-decode" $ \tmpDir -> do+        let path = tmpDir </> "blueprint.dhall"+        writeFile path (sampleBlueprintWithMigrationsDhall "migration-bp")+        result <- evalBlueprintFromFile path+        case result of+          Right b ->+            b.migrations+              `shouldBe` [ BlueprintMigration "1.0.0" "2.0.0" "first edge",+                           BlueprintMigration "2.5.0" "3.0.0" "second edge"+                         ]+          Left err -> expectationFailure ("Expected migrations to decode, got: " <> show err)+   describe "validateBlueprintWith (sample fixture)" $ do     it "accepts the sample-blueprint fixture" $ do       cwd <- getCurrentDirectory@@ -196,6 +219,31 @@             hasError "allowedTools entry must not be empty" errs `shouldBe` True           other -> expectationFailure ("Expected ValidationError, got: " <> show other) +    it "rejects an empty migration prompt" $ do+      let bad = withBlueprintMigrations [BlueprintMigration "1.0.0" "2.0.0" "  "] goodBlueprint+      checkBlueprintMigrations bad `shouldSatisfy` hasError "prompt must not be empty"++    it "rejects malformed migration versions" $ do+      let bad = withBlueprintMigrations [BlueprintMigration "release-1" "next" "change"] goodBlueprint+          errors = checkBlueprintMigrations bad+      errors `shouldSatisfy` hasError "from version is not dotted numeric"+      errors `shouldSatisfy` hasError "to version is not dotted numeric"++    it "rejects migration edges that do not advance" $ do+      let equalEdge = withBlueprintMigrations [BlueprintMigration "2.0.0" "2.0.0" "change"] goodBlueprint+          reverseEdge = withBlueprintMigrations [BlueprintMigration "3.0.0" "2.0.0" "change"] goodBlueprint+      checkBlueprintMigrations equalEdge `shouldSatisfy` hasError "must advance versions"+      checkBlueprintMigrations reverseEdge `shouldSatisfy` hasError "must advance versions"++    it "rejects duplicate migration starts" $ do+      let bad =+            withBlueprintMigrations+              [ BlueprintMigration "1.0.0" "2.0.0" "first",+                BlueprintMigration "1.0.0" "3.0.0" "second"+              ]+              goodBlueprint+      checkBlueprintMigrations bad `shouldSatisfy` hasError "duplicate blueprint migration from version"+     it "rejects a missing referenced file" $ do       withSystemTempDirectory "seihou-test" $ \tmpDir -> do         let bad =@@ -342,3 +390,14 @@       ", tags = [] : List Text",       "}"     ]++sampleBlueprintWithMigrationsDhall :: T.Text -> String+sampleBlueprintWithMigrationsDhall n =+  unlines $+    init (lines (sampleBlueprintDhall n))+      <> [ ", migrations =",+           "    [ { from = \"1.0.0\", to = \"2.0.0\", prompt = \"first edge\" }",+           "    , { from = \"2.5.0\", to = \"3.0.0\", prompt = \"second edge\" }",+           "    ]",+           "}"+         ]

@@ -0,0 +1,41 @@+module Seihou.Core.CommandFingerprintSpec (tests) where++import Data.Text (Text)+import Seihou.Core.CommandFingerprint (fingerprintCommand)+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.CommandFingerprint" spec++commandOp :: Text -> Maybe FilePath -> ModuleName -> Int -> Operation+commandOp command workDir moduleName occurrence =+  RunCommandOp+    { command = command,+      workDir = workDir,+      moduleName = moduleName,+      occurrence = occurrence+    }++spec :: Spec+spec = do+  describe "fingerprintCommand" $ do+    it "is stable for the same rendered command" $ do+      let operation = commandOp "cabal build" (Just "packages/app") "app" 0+      fingerprintCommand operation `shouldBe` fingerprintCommand operation++    it "normalizes project-relative work directories" $ do+      fingerprintCommand (commandOp "cabal build" (Just "packages/./app") "app" 0)+        `shouldBe` fingerprintCommand (commandOp "cabal build" (Just "packages/app") "app" 0)++    it "distinguishes command text, work directory, owner, and occurrence" $ do+      let original = fingerprintCommand (commandOp "cabal build" Nothing "app" 0)+      original `shouldNotBe` fingerprintCommand (commandOp "cabal test" Nothing "app" 0)+      original `shouldNotBe` fingerprintCommand (commandOp "cabal build" (Just "app") "app" 0)+      original `shouldNotBe` fingerprintCommand (commandOp "cabal build" Nothing "other" 0)+      original `shouldNotBe` fingerprintCommand (commandOp "cabal build" Nothing "app" 1)++    it "does not fingerprint file operations" $ do+      fingerprintCommand (WriteFileOp "README.md" "content" Template) `shouldBe` Nothing

@@ -2,10 +2,13 @@  import Data.Text (Text) import Seihou.Core.Migration-  ( Migration (..),+  ( BlueprintMigration (..),+    BlueprintMigrationPlan (..),+    Migration (..),     MigrationOp (..),     MigrationPlan (..),     MigrationPlanError (..),+    planBlueprintMigrationChain,     planMigrationChain,   ) import Seihou.Core.Version (Version, parseVersion)@@ -154,6 +157,47 @@         Right (Just plan) ->           plan.planSteps `shouldBe` [m]         other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++  describe "planBlueprintMigrationChain" $ do+    it "orders in-window migrations while allowing intentional gaps" $ do+      let early = BlueprintMigration "1.0.0" "2.0.0" "first"+          late = BlueprintMigration "2.5.0" "3.0.0" "second"+          result = planBlueprintMigrationChain "demo" [late, early] (mkV "1.0.0") (mkV "3.0.0")+      case result of+        Right (Just plan) -> do+          plan.blueprintPlanName `shouldBe` "demo"+          plan.blueprintPlanFrom `shouldBe` mkV "1.0.0"+          plan.blueprintPlanTo `shouldBe` mkV "3.0.0"+          plan.blueprintPlanSteps `shouldBe` [early, late]+        other -> expectationFailure ("Expected ordered blueprint plan, got: " <> show other)++    it "returns Nothing for an equal version window" $ do+      planBlueprintMigrationChain "demo" [] (mkV "1.0.0") (mkV "1.0.0")+        `shouldBe` Right Nothing++    it "rejects a downgrade" $ do+      planBlueprintMigrationChain "demo" [] (mkV "3.0.0") (mkV "2.0.0")+        `shouldBe` Left (MigrationDowngradeNotSupported (mkV "3.0.0") (mkV "2.0.0"))++    it "rejects an unparseable declared version" $ do+      let migration = BlueprintMigration "release-1" "2.0.0" "change"+      planBlueprintMigrationChain "demo" [migration] (mkV "1.0.0") (mkV "2.0.0")+        `shouldBe` Left (MigrationVersionUnparseable "release-1")++    it "rejects duplicate starts" $ do+      let first = BlueprintMigration "1.0.0" "2.0.0" "first"+          second = BlueprintMigration "1.0.0" "1.5.0" "second"+          result = planBlueprintMigrationChain "demo" [first, second] (mkV "1.0.0") (mkV "2.0.0")+      case result of+        Left (MigrationDuplicateEdge fromVersion _) -> fromVersion `shouldBe` mkV "1.0.0"+        other -> expectationFailure ("Expected duplicate blueprint edge error, got: " <> show other)++    it "skips an edge that overshoots the target" $ do+      let migration = BlueprintMigration "1.0.0" "3.0.0" "too far"+          result = planBlueprintMigrationChain "demo" [migration] (mkV "1.0.0") (mkV "2.0.0")+      case result of+        Right (Just plan) -> plan.blueprintPlanSteps `shouldBe` []+        other -> expectationFailure ("Expected empty blueprint plan, got: " <> show other)  -- --------------------------------------------------------------------------- -- Helpers

@@ -103,6 +103,7 @@       let content = blueprintDhall "test-bp" schemaPath ""       T.isInfixOf "let S =" content `shouldBe` True       T.isInfixOf "S.Blueprint::" content `shouldBe` True+      T.isInfixOf "migrations = [] : List S.BlueprintMigration.Type" content `shouldBe` True      it "imports prompt.md as Text rather than inlining the body" $ do       schemaPath <- resolveSchemaPath@@ -160,6 +161,7 @@             length (b.baseModules) `shouldBe` 0             length (b.files) `shouldBe` 0             length (b.tags) `shouldBe` 0+            length (b.migrations) `shouldBe` 0    describe "examplePromptMarkdown" $ do     it "contains the {{project.name}} placeholder so authors see substitution" $ do

@@ -28,7 +28,9 @@     { hash = hashContent content,       moduleName = modName,       strategy = Template,-      generatedAt = fixedTime+      generatedAt = fixedTime,+      baseline = Nothing,+      applicationIds = mempty     }  runStatus :: PureFS -> Manifest -> [TrackedFile]

@@ -132,7 +132,7 @@       op.src `shouldBe` "a.txt"      it "supports RunCommandOp" $ do-      let op = RunCommandOp {command = "git init", workDir = Nothing}+      let op = RunCommandOp {command = "git init", workDir = Nothing, moduleName = "test", occurrence = 0}       op.command `shouldBe` "git init"    describe "Expr" $ do

@@ -0,0 +1,104 @@+module Seihou.Effect.BaselineStoreSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as T+import Effectful+import Seihou.Core.Types (BaselineRef (..), SHA256 (..))+import Seihou.Effect.BaselineStore+import Seihou.Effect.BaselineStoreInterp (runBaselineStore)+import Seihou.Effect.BaselineStorePure (runBaselineStorePure)+import Seihou.Effect.Filesystem (writeFileText)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)+import Seihou.Manifest.Hash (baselineRefForContent, hashContent)+import System.Directory qualified as Directory+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Effect.BaselineStore" spec++spec :: Spec+spec = do+  describe "pure interpreter" $ do+    it "deduplicates identical content and round-trips it" $ do+      let ((ref1, ref2, result), store) = runPureEff $ runBaselineStorePure Map.empty $ do+            first <- putBaseline "generated text"+            second <- putBaseline "generated text"+            stored <- readBaseline first+            pure (first, second, stored)+      ref1 `shouldBe` ref2+      result `shouldBe` Right "generated text"+      Map.size store `shouldBe` 1++    it "reports missing and corrupt content" $ do+      let missingRef = baselineRefForContent "missing"+          corruptRef = baselineRefForContent "expected"+          initial = Map.singleton corruptRef "tampered"+          ((missing, corrupt), _) = runPureEff $ runBaselineStorePure initial $ do+            missingResult <- readBaseline missingRef+            corruptResult <- readBaseline corruptRef+            pure (missingResult, corruptResult)+      missing `shouldBe` Left (BaselineMissing missingRef)+      corrupt `shouldBe` Left (BaselineCorrupt corruptRef (hashContent "tampered"))++    it "prunes only valid unreferenced entries" $ do+      let kept = baselineRefForContent "kept"+          removed = baselineRefForContent "removed"+          corrupt = baselineRefForContent "expected"+          initial = Map.fromList [(kept, "kept"), (removed, "removed"), (corrupt, "tampered")]+          (pruned, store) = runPureEff $ runBaselineStorePure initial (pruneBaselines (Set.singleton kept))+      pruned `shouldBe` [removed]+      Map.keysSet store `shouldBe` Set.fromList [kept, corrupt]++  describe "filesystem interpreter" $ do+    it "writes atomically, detects tampering, cleans temp files, and prunes safely" $ do+      let baselineDir = ".seihou/baselines"+          kept = baselineRefForContent "kept"+          removed = baselineRefForContent "removed"+          keptPath = baselineDir </> refName kept+          removedPath = baselineDir </> refName removed+          staleTemp = keptPath <> ".tmp"+          unrelated = baselineDir </> "README"+          action = do+            writeFileText staleTemp "partial"+            keptRef <- putBaseline "kept"+            removedRef <- putBaseline "removed"+            writeFileText unrelated "leave me"+            beforeTamper <- readBaseline keptRef+            writeFileText keptPath "tampered"+            afterTamper <- readBaseline keptRef+            writeFileText keptPath "kept"+            pruned <- pruneBaselines (Set.singleton keptRef)+            pure (removedRef, beforeTamper, afterTamper, pruned)+          ((removedRef, beforeTamper, afterTamper, pruned), fs) =+            runPureEff $ runFilesystemPure emptyFS $ runBaselineStore baselineDir action+      removedRef `shouldBe` removed+      beforeTamper `shouldBe` Right "kept"+      afterTamper `shouldBe` Left (BaselineCorrupt kept (hashContent "tampered"))+      pruned `shouldBe` [removed]+      Map.lookup keptPath fs.files `shouldBe` Just "kept"+      Map.member removedPath fs.files `shouldBe` False+      Map.lookup unrelated fs.files `shouldBe` Just "leave me"+      Map.member staleTemp fs.files `shouldBe` False++    it "round-trips on a real filesystem with one deduplicated blob" $ do+      withSystemTempDirectory "seihou-baselines" $ \tmpDir -> do+        let baselineDir = tmpDir </> ".seihou" </> "baselines"+        (ref1, ref2, result) <-+          runEff $ runFilesystem $ runBaselineStore baselineDir $ do+            first <- putBaseline "real content"+            second <- putBaseline "real content"+            stored <- readBaseline first+            pure (first, second, stored)+        entries <- Directory.listDirectory baselineDir+        ref1 `shouldBe` ref2+        result `shouldBe` Right "real content"+        entries `shouldBe` [refName ref1]++refName :: BaselineRef -> FilePath+refName (BaselineRef (SHA256 value)) = T.unpack value

@@ -36,7 +36,7 @@       files =         Map.fromList           [ ( "README.md",-              FileRecord (SHA256 "abc123") (ModuleName "haskell-base") Template fixedTime+              FileRecord (SHA256 "abc123") (ModuleName "haskell-base") Template fixedTime Nothing mempty             )           ]     }@@ -94,7 +94,7 @@                 runManifestStore manifestPath (writeManifest sampleManifest)                 c <- readFileText manifestPath                 pure ((), c)-      T.isInfixOf "\"version\":3" content `shouldBe` True+      T.isInfixOf "\"version\":5" content `shouldBe` True       T.isInfixOf "haskell-base" content `shouldBe` True       T.isInfixOf "my-app" content `shouldBe` True 

@@ -0,0 +1,103 @@+module Seihou.Engine.BaselineSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful+import Seihou.Core.Types+import Seihou.Effect.BaselineStore (BaselineError (..), readBaseline)+import Seihou.Effect.BaselineStorePure (runBaselineStorePure)+import Seihou.Effect.FilesystemPure (PureFS (..), runFilesystemPure)+import Seihou.Engine.Baseline+import Seihou.Manifest.Hash (baselineRefForContent, hashContent)+import Seihou.Manifest.Types (emptyManifest)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Baseline" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"++spec :: Spec+spec = do+  describe "recordGeneratedBaselines" $ do+    it "captures post-execution content and preserves ownership metadata" $ do+      let path = "README.md"+          content = "generated after patch\n"+          applicationId = ApplicationId "application"+          record =+            FileRecord+              { hash = hashContent "stale pre-patch content",+                moduleName = ModuleName "module",+                strategy = Template,+                generatedAt = fixedTime,+                baseline = Nothing,+                applicationIds = Set.singleton applicationId+              }+          initialFS = PureFS (Map.singleton ("/project/" <> path) content) Set.empty+          ((result, stored), _) =+            runPureEff $+              runFilesystemPure initialFS $+                runBaselineStorePure Map.empty $+                  recordGeneratedBaselines "/project" (Map.singleton path record)+      case result of+        Left err -> expectationFailure ("unexpected baseline error: " <> show err)+        Right records -> do+          let enriched = records Map.! path+              expectedRef = baselineRefForContent content+          enriched.hash `shouldBe` hashContent content+          enriched.baseline `shouldBe` Just expectedRef+          enriched.applicationIds `shouldBe` Set.singleton applicationId+          Map.lookup expectedRef stored `shouldBe` Just content++    it "returns an error and publishes no reference when a generated file is missing" $ do+      let record = FileRecord (hashContent "planned") "module" Template fixedTime Nothing Set.empty+          ((result, stored), _) =+            runPureEff $+              runFilesystemPure (PureFS Map.empty Set.empty) $+                runBaselineStorePure Map.empty $+                  recordGeneratedBaselines "/project" (Map.singleton "missing.txt" record)+      result `shouldSatisfy` isStoreFailure+      stored `shouldBe` Map.empty++    it "stores content that can be read back through the baseline effect" $ do+      let content = "round trip"+          record = FileRecord (hashContent content) "module" Copy fixedTime Nothing Set.empty+          initialFS = PureFS (Map.singleton "copy.txt" content) Set.empty+          ((result, readBack), _) =+            runPureEff $+              runFilesystemPure initialFS $+                runBaselineStorePure Map.empty $ do+                  captured <- recordGeneratedBaselines "" (Map.singleton "copy.txt" record)+                  case captured of+                    Left err -> pure (Left err)+                    Right records -> case (records Map.! "copy.txt").baseline of+                      Nothing -> pure (Left (BaselineStoreFailure "missing reference"))+                      Just ref -> readBaseline ref+      result `shouldBe` Right "round trip"+      readBack `shouldBe` Map.singleton (baselineRefForContent content) content++  describe "manifestBaselineRefs" $ do+    it "collects and deduplicates every referenced blob" $ do+      let first = baselineRefForContent "first"+          second = baselineRefForContent "second"+          mkRecord ref = FileRecord (hashContent "applied") "module" Template fixedTime ref Set.empty+          manifest :: Manifest+          manifest =+            (emptyManifest fixedTime)+              { files =+                  Map.fromList+                    [ ("a", mkRecord (Just first)),+                      ("b", mkRecord (Just first)),+                      ("c", mkRecord (Just second)),+                      ("legacy", mkRecord Nothing)+                    ]+              }+      manifestBaselineRefs manifest `shouldBe` Set.fromList [first, second]++isStoreFailure :: Either BaselineError a -> Bool+isStoreFailure (Left (BaselineStoreFailure _)) = True+isStoreFailure _ = False

@@ -36,7 +36,9 @@     { hash = hashContent content,       moduleName = modName,       strategy = Template,-      generatedAt = fixedTime+      generatedAt = fixedTime,+      baseline = Nothing,+      applicationIds = mempty     }  -- | Helper to create a manifest with file records (avoids ambiguous record update).@@ -48,7 +50,11 @@           genAt = base.genAt,           modules = base.modules,           vars = base.vars,-          files = recs+          files = recs,+          applications = base.applications,+          recipe = base.recipe,+          blueprint = base.blueprint,+          blueprintMigrations = base.blueprintMigrations         }  spec :: Spec@@ -202,7 +208,9 @@               { hash = hashContent content,                 moduleName = otherMod,                 strategy = Template,-                generatedAt = fixedTime+                generatedAt = fixedTime,+                baseline = Nothing,+                applicationIds = mempty               }           manifest = manifestWithFiles (Map.singleton "other.txt" record)           planned = [("new.txt", "new content", modName, Nothing)]@@ -229,7 +237,9 @@               { hash = hashContent "other content",                 moduleName = otherMod,                 strategy = Copy,-                generatedAt = fixedTime+                generatedAt = fixedTime,+                baseline = Nothing,+                applicationIds = mempty               }           manifest =             manifestWithFiles@@ -260,7 +270,9 @@               { hash = hashContent "other content",                 moduleName = otherMod,                 strategy = Template,-                generatedAt = fixedTime+                generatedAt = fixedTime,+                baseline = Nothing,+                applicationIds = mempty               }           manifest = manifestWithFiles (Map.singleton "shared.txt" otherRecord)           -- active module wants to write to same path owned by inactive module@@ -281,7 +293,9 @@               { hash = hashContent content,                 moduleName = m,                 strategy = Template,-                generatedAt = fixedTime+                generatedAt = fixedTime,+                baseline = Nothing,+                applicationIds = mempty               }           manifest =             manifestWithFiles

@@ -88,7 +88,7 @@       Map.lookup "/project/src/Main.hs" (fs.files) `shouldBe` Just "module Main where"      it "skips RunCommandOp" $ do-      let ops = [RunCommandOp "echo hello" Nothing]+      let ops = [RunCommandOp "echo hello" Nothing modName 0]           (records, _) = runExecFS emptyFS ops       Map.size records `shouldBe` 0 @@ -190,7 +190,7 @@       T.isInfixOf "copy" result `shouldBe` True      it "formats RunCommandOp" $ do-      let result = dryRunPlan [RunCommandOp "echo hello" Nothing]+      let result = dryRunPlan [RunCommandOp "echo hello" Nothing modName 0]       T.isInfixOf "run" result `shouldBe` True      it "returns message for empty plan" $ do

@@ -72,7 +72,9 @@                 { hash = hashContent content,                   moduleName = modName,                   strategy = Template,-                  generatedAt = fixedTime+                  generatedAt = fixedTime,+                  baseline = Nothing,+                  applicationIds = mempty                 }             )           | (path, content) <- entries

@@ -557,7 +557,7 @@               -- Should have CreateDirOp for src/               dirOps `shouldSatisfy` any (\op -> op.path == "src")               -- Should have RunCommandOp for the command-              let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+              let cmdOps = [op | op@RunCommandOp {} <- ops]               length cmdOps `shouldBe` 1               (cmdOps !! 0).command `shouldBe` "echo 'Project generated'" @@ -747,12 +747,42 @@         result <- compilePlan baseDir modul vars         case result of           Right ops -> do-            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            let cmdOps = [op | op@RunCommandOp {} <- ops]             length cmdOps `shouldBe` 1             (cmdOps !! 0).command `shouldBe` "echo hello"             (cmdOps !! 0).workDir `shouldBe` Nothing+            (cmdOps !! 0).moduleName `shouldBe` "test"+            (cmdOps !! 0).occurrence `shouldBe` 0           Left errs -> expectationFailure ("Expected Right, got: " <> show errs) +    it "numbers only identical rendered commands from the same module" $ do+      withFixture [] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [],+                  commands =+                    [ Command "echo same" Nothing Nothing,+                      Command "echo other" Nothing Nothing,+                      Command "echo same" Nothing Nothing+                    ],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+        result <- compilePlan baseDir modul Map.empty+        case result of+          Right ops -> do+            let commandOccurrences = [(op.command, op.occurrence) | op@RunCommandOp {} <- ops]+            commandOccurrences+              `shouldBe` [("echo same", 0), ("echo other", 0), ("echo same", 1)]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)+     it "skips command when condition is false" $ do       withFixture [("data.txt", "content")] $ \baseDir -> do         let modul =@@ -773,7 +803,7 @@         result <- compilePlan baseDir modul vars         case result of           Right ops -> do-            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            let cmdOps = [op | op@RunCommandOp {} <- ops]             length cmdOps `shouldBe` 0           Left errs -> expectationFailure ("Expected Right, got: " <> show errs) @@ -797,7 +827,7 @@         result <- compilePlan baseDir modul vars         case result of           Right ops -> do-            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            let cmdOps = [op | op@RunCommandOp {} <- ops]             length cmdOps `shouldBe` 1           Left errs -> expectationFailure ("Expected Right, got: " <> show errs) @@ -854,7 +884,7 @@         result <- compilePlan baseDir modul vars         case result of           Right ops -> do-            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            let cmdOps = [op | op@RunCommandOp {} <- ops]             length cmdOps `shouldBe` 1             (cmdOps !! 0).workDir `shouldBe` Just "subdir"           Left errs -> expectationFailure ("Expected Right, got: " <> show errs)@@ -879,7 +909,7 @@         result <- compilePlan baseDir modul vars         case result of           Right ops -> do-            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            let cmdOps = [op | op@RunCommandOp {} <- ops]             length cmdOps `shouldBe` 1             (cmdOps !! 0).command `shouldBe` "echo my-app"           Left errs -> expectationFailure ("Expected Right, got: " <> show errs)@@ -904,7 +934,7 @@         result <- compilePlan baseDir modul vars         case result of           Right ops -> do-            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            let cmdOps = [op | op@RunCommandOp {} <- ops]             length cmdOps `shouldBe` 1             (cmdOps !! 0).workDir `shouldBe` Just "my-app"           Left errs -> expectationFailure ("Expected Right, got: " <> show errs)

@@ -122,13 +122,28 @@         _ -> expectationFailure "Expected DirPreview"      it "produces CommandPreview for RunCommandOp" $ do-      let ops = [RunCommandOp "cabal build" Nothing]+      let ops = [RunCommandOp "cabal build" Nothing modName 0]           result = buildPreview ops Nothing Map.empty       length result `shouldBe` 1       case head result of-        CommandPreview cmd -> cmd `shouldBe` "cabal build"+        CommandPreview cmd owner -> do+          cmd `shouldBe` "cabal build"+          owner `shouldBe` Nothing         _ -> expectationFailure "Expected CommandPreview" +    it "shows command ownership only when identical text has multiple owners" $ do+      let ops =+            [ RunCommandOp "cabal build" Nothing modName 0,+              RunCommandOp "cabal build" Nothing modName2 0,+              RunCommandOp "cabal test" Nothing modName 0+            ]+          result = buildPreview ops Nothing Map.empty+      result+        `shouldBe` [ CommandPreview "cabal build" (Just modName),+                     CommandPreview "cabal build" (Just modName2),+                     CommandPreview "cabal test" Nothing+                   ]+     it "maps PatchFileOp to FilePreview with patch annotation" $ do       let ops = [PatchFileOp "README.md" "extra content" AppendSection Template modName]           result = buildPreview ops Nothing Map.empty@@ -186,7 +201,7 @@     it "renders DirPreview, CommandPreview, and OrphanPreview" $ do       let lines' =             [ DirPreview "src",-              CommandPreview "cabal build",+              CommandPreview "cabal build" Nothing,               OrphanPreview "gone.txt" modName             ]           rendered = renderPreviewPlain lines'

@@ -0,0 +1,330 @@+module Seihou.Engine.ReconcileSpec (tests) where++import Data.Functor.Identity (Identity (..))+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Seihou.Core.Types hiding (KeepCurrent)+import Seihou.Effect.BaselineStore (BaselineError (..))+import Seihou.Engine.Reconcile+import Seihou.Engine.ThreeWayMerge (MergeOutcome (..))+import Seihou.Manifest.Hash (baselineRefForContent, hashContent)+import Seihou.Manifest.Types (emptyManifest)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Reconcile" spec++spec :: Spec+spec = do+  describe "materialization" $ do+    it "folds four ordered patches into one desired file" $ do+      let operations =+            [ patch "one" "mod-a",+              patch "two" "mod-b",+              patch "two" "mod-c",+              patch "three" "mod-d"+            ]+          result = planWith (Map.singleton ".gitignore" "root\n") Map.empty Map.empty empty [appA] operations (owners ".gitignore" [appA]) cleanMerge+      case result of+        Right reconciliation -> do+          Map.size reconciliation.files `shouldBe` 1+          case reconciliation.files Map.! ".gitignore" of+            FileUpdate desired _ _ _ -> desired.generatedContent `shouldBe` "root\none\ntwo\nthree\n"+            other -> expectationFailure ("expected one update, got " <> show other)+        Left err -> expectationFailure (show err)++    it "replays a patch after a complete write" $ do+      let operations =+            [ WriteFileOp "README.md" "generated\n" Template,+              PatchFileOp "README.md" "added\n" AppendFile Template "mod-b"+            ]+          result = planWith Map.empty Map.empty Map.empty empty [appA] operations (owners "README.md" [appA]) cleanMerge+      case result of+        Right reconciliation -> case reconciliation.files Map.! "README.md" of+          FileCreate desired _ _ -> desired.generatedContent `shouldBe` "generated\nadded\n"+          other -> expectationFailure ("expected create, got " <> show other)+        Left err -> expectationFailure (show err)++    it "materializes copy operations through the supplied source reader" $ do+      let operations = [CopyFileOp "/staged/template" "copied.txt"]+          result =+            planWith+              Map.empty+              (Map.singleton "/staged/template" "copied\n")+              Map.empty+              empty+              [appA]+              operations+              (owners "copied.txt" [appA])+              cleanMerge+      case result of+        Right reconciliation -> case reconciliation.files Map.! "copied.txt" of+          FileCreate desired _ _ -> do+            desired.generatedContent `shouldBe` "copied\n"+            desired.strategy `shouldBe` Copy+          other -> expectationFailure ("expected create, got " <> show other)+        Left err -> expectationFailure (show err)++  describe "baseline trust and application scoping" $ do+    it "adopts a legacy disk baseline only when its recorded hash matches" $ do+      let manifest = withFile "legacy.txt" (record "legacy\n" Nothing [appA]) empty+          result =+            planWith+              (Map.singleton "legacy.txt" "legacy\n")+              Map.empty+              Map.empty+              manifest+              [appA]+              [WriteFileOp "legacy.txt" "new\n" Template]+              (owners "legacy.txt" [appA])+              cleanMerge+      case result of+        Right reconciliation -> case reconciliation.files Map.! "legacy.txt" of+          FileUpdate _ _ _ _ -> pure ()+          other -> expectationFailure ("expected trusted update, got " <> show other)+        Left err -> expectationFailure (show err)++    it "refuses to guess a legacy baseline after a user edit" $ do+      let manifest = withFile "legacy.txt" (record "legacy\n" Nothing [appA]) empty+          result =+            planWith+              (Map.singleton "legacy.txt" "user edit\n")+              Map.empty+              Map.empty+              manifest+              [appA]+              [WriteFileOp "legacy.txt" "new\n" Template]+              (owners "legacy.txt" [appA])+              cleanMerge+      case result of+        Right reconciliation -> case reconciliation.files Map.! "legacy.txt" of+          FileConflict _ current _ MissingTrustedBaseline _ _ Nothing -> current `shouldBe` "user edit\n"+          other -> expectationFailure ("expected conservative conflict, got " <> show other)+        Left err -> expectationFailure (show err)++    it "reports every owner when a targeted update regenerates a shared path" $ do+      let manifest = withFile "shared.txt" (record "old\n" Nothing [appA, appB]) empty+          result =+            planWith+              (Map.singleton "shared.txt" "old\n")+              Map.empty+              Map.empty+              manifest+              [appA]+              [WriteFileOp "shared.txt" "new\n" Template]+              (owners "shared.txt" [appA])+              cleanMerge+      result `shouldBe` Left (SharedPathRequiresApplications "shared.txt" (Set.fromList [appA, appB]))++    it "rejects a newly colliding path owned only by an unselected application" $ do+      let manifest = withFile "shared.txt" (record "old\n" Nothing [appB]) empty+          result =+            planWith+              (Map.singleton "shared.txt" "old\n")+              Map.empty+              Map.empty+              manifest+              [appA]+              [WriteFileOp "shared.txt" "new\n" Template]+              (owners "shared.txt" [appA])+              cleanMerge+      result `shouldBe` Left (SharedPathRequiresApplications "shared.txt" (Set.singleton appB))++    it "rejects control paths before reading or planning" $ do+      let result =+            planWith+              Map.empty+              Map.empty+              Map.empty+              empty+              [appA]+              [WriteFileOp ".seihou/manifest.json" "bad" Template]+              (owners ".seihou/manifest.json" [appA])+              cleanMerge+      result `shouldSatisfy` isInvalidPath++  describe "classification and resolution" $ do+    it "preserves a user-only edit without advancing its applied hash" $ do+      let base = "base\n"+          ref = baselineRefForContent base+          oldRecord = record base (Just ref) [appA]+          manifest = withFile "file.txt" oldRecord empty+          result =+            planWith+              (Map.singleton "file.txt" "user\n")+              Map.empty+              (Map.singleton ref base)+              manifest+              [appA]+              [WriteFileOp "file.txt" base Template]+              (owners "file.txt" [appA])+              cleanMerge+      case result of+        Right reconciliation -> case reconciliation.files Map.! "file.txt" of+          FileUnchanged _ state _ _ -> do+            state.appliedContent `shouldBe` "user\n"+            state.recordedHash `shouldBe` oldRecord.hash+            state.writeToDisk `shouldBe` False+          other -> expectationFailure ("expected unchanged user edit, got " <> show other)+        Left err -> expectationFailure (show err)++    it "classifies a clean dual edit as one automatic merge" $ do+      let base = "base\n"+          ref = baselineRefForContent base+          manifest = withFile "file.txt" (record base (Just ref) [appA]) empty+          result =+            planWith+              (Map.singleton "file.txt" "user\n")+              Map.empty+              (Map.singleton ref base)+              manifest+              [appA]+              [WriteFileOp "file.txt" "generated\n" Template]+              (owners "file.txt" [appA])+              (\_ _ _ -> MergeClean "user and generated\n")+      case result of+        Right reconciliation -> do+          case reconciliation.files Map.! "file.txt" of+            FileAutoMerge _ state _ _ -> state.appliedContent `shouldBe` "user and generated\n"+            other -> expectationFailure ("expected automatic merge, got " <> show other)+          reconciliationSummary reconciliation `shouldBe` ReconciliationSummary 0 0 1 0 0 0 0 0+        Left err -> expectationFailure (show err)++    it "keeps overlapping edits unresolved until an explicit choice" $ do+      let base = "base\n"+          ref = baselineRefForContent base+          markers = "<<<<<<< current\nuser\n=======\ngenerated\n>>>>>>> new-generated\n"+          manifest = withFile "file.txt" (record base (Just ref) [appA]) empty+          planned =+            planWith+              (Map.singleton "file.txt" "user\n")+              Map.empty+              (Map.singleton ref base)+              manifest+              [appA]+              [WriteFileOp "file.txt" "generated\n" Template]+              (owners "file.txt" [appA])+              (\_ _ _ -> MergeConflicted markers)+      case planned of+        Left err -> expectationFailure (show err)+        Right reconciliation -> do+          unresolvedPaths reconciliation `shouldBe` Set.singleton "file.txt"+          let resolved = resolveFileConflict "file.txt" KeepCurrent reconciliation+          case resolved of+            Left err -> expectationFailure (show err)+            Right finalPlan -> case finalPlan.files Map.! "file.txt" of+              FileConflict _ _ _ _ _ _ (Just resolution) -> do+                resolution.state.generatedBaseline `shouldBe` "generated\n"+                resolution.state.appliedContent `shouldBe` "user\n"+                unresolvedPaths finalPlan `shouldBe` Set.empty+              other -> expectationFailure ("expected resolved conflict, got " <> show other)++  describe "orphan handling" $ do+    it "distinguishes safe deletion, edited retention, and shared release" $ do+      let manifest =+            withFile "safe.txt" (record "safe\n" Nothing [appA]) $+              withFile "edited.txt" (record "before\n" Nothing [appA]) $+                withFile "shared.txt" (record "shared\n" Nothing [appA, appB]) empty+          disk =+            Map.fromList+              [ ("safe.txt", "safe\n"),+                ("edited.txt", "user\n"),+                ("shared.txt", "shared\n")+              ]+          result = planWith disk Map.empty Map.empty manifest [appA] [] Map.empty cleanMerge+      case result of+        Left err -> expectationFailure (show err)+        Right reconciliation -> do+          reconciliation.files Map.! "safe.txt" `shouldSatisfy` isSafeDelete+          reconciliation.files Map.! "edited.txt" `shouldSatisfy` isEditedOrphan+          reconciliation.files Map.! "shared.txt" `shouldSatisfy` isSharedRelease+          unresolvedPaths reconciliation `shouldBe` Set.singleton "edited.txt"+          case resolveEditedOrphan "edited.txt" RetainTrackedOrphan reconciliation of+            Left err -> expectationFailure (show err)+            Right resolved -> unresolvedPaths resolved `shouldBe` Set.empty++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-19T12:00:00Z"++appA, appB :: ApplicationId+appA = ApplicationId "app-a"+appB = ApplicationId "app-b"++empty :: Manifest+empty = emptyManifest fixedTime++withFile :: FilePath -> FileRecord -> Manifest -> Manifest+withFile path fileRecord manifest =+  Manifest+    { version = manifest.version,+      genAt = manifest.genAt,+      modules = manifest.modules,+      vars = manifest.vars,+      files = Map.insert path fileRecord manifest.files,+      applications = manifest.applications,+      recipe = manifest.recipe,+      blueprint = manifest.blueprint,+      blueprintMigrations = manifest.blueprintMigrations+    }++record :: Text -> Maybe BaselineRef -> [ApplicationId] -> FileRecord+record content baseline owners' =+  FileRecord+    { hash = hashContent content,+      moduleName = "owner",+      strategy = Template,+      generatedAt = fixedTime,+      baseline = baseline,+      applicationIds = Set.fromList owners'+    }++owners :: FilePath -> [ApplicationId] -> Map.Map FilePath DesiredFileOwner+owners path ownerIds = Map.singleton path (DesiredFileOwner "owner" (Set.fromList ownerIds))++patch :: Text -> ModuleName -> Operation+patch content moduleName = PatchFileOp ".gitignore" (content <> "\n") AppendLineIfAbsent Template moduleName++cleanMerge :: Text -> Text -> Text -> MergeOutcome+cleanMerge _ _ generated = MergeClean generated++planWith ::+  Map.Map FilePath Text ->+  Map.Map FilePath Text ->+  Map.Map BaselineRef Text ->+  Manifest ->+  [ApplicationId] ->+  [Operation] ->+  Map.Map FilePath DesiredFileOwner ->+  (Text -> Text -> Text -> MergeOutcome) ->+  Either ReconciliationError ReconciliationPlan+planWith disk copySources baselines manifest selected operations ownerMap merge =+  runIdentity $+    planReconciliationWith+      (pure . (`Map.lookup` disk))+      (\path -> pure (maybe (Left (CopySourceUnavailable path)) Right (Map.lookup path copySources)))+      (\ref -> pure (maybe (Left (BaselineMissing ref)) Right (Map.lookup ref baselines)))+      (\base current generated -> pure (merge base current generated))+      manifest+      (Set.fromList selected)+      operations+      ownerMap++isInvalidPath :: Either ReconciliationError ReconciliationPlan -> Bool+isInvalidPath (Left (InvalidReconciliationPath _ _)) = True+isInvalidPath _ = False++isSafeDelete :: FileReconciliation -> Bool+isSafeDelete (FileDeleteSafe _ _ _) = True+isSafeDelete _ = False++isEditedOrphan :: FileReconciliation -> Bool+isEditedOrphan (FileOrphanEdited _ _ _ _ _) = True+isEditedOrphan _ = False++isSharedRelease :: FileReconciliation -> Bool+isSharedRelease (FileReleaseSharedOwnership _ _ _) = True+isSharedRelease _ = False

@@ -50,7 +50,9 @@                 { hash = hashContent content,                   moduleName = modName,                   strategy = Template,-                  generatedAt = fixedTime+                  generatedAt = fixedTime,+                  baseline = Nothing,+                  applicationIds = mempty                 }             )           | (path, content) <- fileContents@@ -64,6 +66,7 @@     { modules =         [ AppliedModule             { name = modName,+              parentVars = emptyParentVars,               source = "/path/to/test-module",               moduleVersion = Nothing,               appliedAt = fixedTime,@@ -77,7 +80,9 @@                 { hash = hashContent content,                   moduleName = modName,                   strategy = Template,-                  generatedAt = fixedTime+                  generatedAt = fixedTime,+                  baseline = Nothing,+                  applicationIds = mempty                 }             )           | (path, content) <- fileContents@@ -197,14 +202,18 @@      it "preserves files from other modules in manifest" $ do       let base = mkManifest True [("mine.txt", "mine")]-          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime+          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime Nothing mempty           manifest =             Manifest               { version = base.version,                 genAt = base.genAt,                 modules = base.modules,                 vars = base.vars,-                files = Map.insert "other.txt" otherRec base.files+                files = Map.insert "other.txt" otherRec base.files,+                applications = base.applications,+                recipe = base.recipe,+                blueprint = base.blueprint,+                blueprintMigrations = base.blueprintMigrations               }           fs = mkFS [("mine.txt", "mine"), ("other.txt", "other")]           plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "mine.txt"]}@@ -376,14 +385,18 @@      it "preserves other modules' files in manifest" $ do       let base = mkManifest True [("mine.txt", "mine")]-          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime+          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime Nothing mempty           manifest =             Manifest               { version = base.version,                 genAt = base.genAt,                 modules = base.modules,                 vars = base.vars,-                files = Map.insert "other.txt" otherRec base.files+                files = Map.insert "other.txt" otherRec base.files,+                applications = base.applications,+                recipe = base.recipe,+                blueprint = base.blueprint,+                blueprintMigrations = base.blueprintMigrations               }           fs = mkFS [("mine.txt", "mine"), ("other.txt", "other")]           plan = ExecutedRemovalPlan modName [DeleteFileOp "mine.txt" RFSafe]

@@ -0,0 +1,118 @@+module Seihou.Engine.ThreeWayMergeSpec (tests) where++import Control.Monad (unless)+import Data.Maybe (isJust)+import Data.Text qualified as T+import Seihou.Engine.ThreeWayMerge+import System.Directory (findExecutable)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.ThreeWayMerge" spec++spec :: Spec+spec = do+  describe "pure safety cases" $ do+    it "takes newly generated content when current still equals baseline" $+      threeWayMerge "base" "base" "new" `shouldReturn` MergeClean "new"++    it "preserves current content when generation did not change" $+      threeWayMerge "base" "user" "base" `shouldReturn` MergeClean "user"++    it "returns identical current and generated content" $+      threeWayMerge "base" "same" "same" `shouldReturn` MergeClean "same"++    it "handles empty content through an identity without invoking Git" $+      threeWayMerge "" "" "generated" `shouldReturn` MergeClean "generated"++    it "rejects NUL-bearing binary content even when both sides match" $ do+      result <- threeWayMerge "a\NULb" "a\NULb" "a\NULb"+      result `shouldSatisfy` isUnavailable++    it "returns unavailable when the Git executable is missing" $ do+      result <- threeWayMergeWithGit "/definitely/missing/seihou-git" "base" "user" "generated"+      result `shouldSatisfy` isUnavailable++    it "returns unavailable for a fatal driver result without markers" $ do+      result <- threeWayMergeWithGit "/usr/bin/false" "base" "user" "generated"+      result `shouldSatisfy` isUnavailable++  describe "git merge-file driver" $ do+    it "merges non-overlapping user and module insertions" $ withGit $ do+      let baseline = "alpha\nshared\nomega\n"+          current = "alpha\nuser\nshared\nomega\n"+          generated = "alpha\nshared\nmodule\nomega\n"+      result <- threeWayMerge baseline current generated+      case result of+        MergeClean merged -> do+          merged `shouldSatisfy` T.isInfixOf "user"+          merged `shouldSatisfy` T.isInfixOf "module"+        other -> expectationFailure ("expected clean merge, got " <> show other)++    it "returns labeled diff3 markers for overlapping replacements" $ withGit $ do+      result <- threeWayMerge "alpha\nshared\nomega\n" "alpha\nuser\nomega\n" "alpha\nmodule\nomega\n"+      case result of+        MergeConflicted merged -> do+          merged `shouldSatisfy` T.isInfixOf "<<<<<<< current"+          merged `shouldSatisfy` T.isInfixOf "||||||| generated-base"+          merged `shouldSatisfy` T.isInfixOf ">>>>>>> new-generated"+        other -> expectationFailure ("expected conflict, got " <> show other)++    it "preserves a user-only deletion alongside a generated insertion" $ withGit $ do+      result <-+        threeWayMerge+          "alpha\nremove-me\nomega\n"+          "alpha\nomega\n"+          "alpha\nremove-me\nomega\nmodule\n"+      case result of+        MergeClean merged -> do+          merged `shouldNotSatisfy` T.isInfixOf "remove-me"+          merged `shouldSatisfy` T.isInfixOf "module"+        other -> expectationFailure ("expected clean merge, got " <> show other)++    it "preserves a generated deletion alongside a user insertion" $ withGit $ do+      result <-+        threeWayMerge+          "alpha\nuser-anchor\nmiddle\nremove-me\nomega\n"+          "alpha\nuser\nuser-anchor\nmiddle\nremove-me\nomega\n"+          "alpha\nuser-anchor\nmiddle\nomega\n"+      case result of+        MergeClean merged -> do+          merged `shouldNotSatisfy` T.isInfixOf "remove-me"+          merged `shouldSatisfy` T.isInfixOf "user"+        other -> expectationFailure ("expected clean merge, got " <> show other)++    it "handles missing trailing newlines" $ withGit $ do+      result <- threeWayMerge "alpha\nmiddle\nomega" "user-alpha\nmiddle\nomega" "alpha\nmiddle\nmodule-omega"+      case result of+        MergeClean merged -> do+          merged `shouldSatisfy` T.isInfixOf "user-alpha"+          merged `shouldSatisfy` T.isInfixOf "module-omega"+        other -> expectationFailure ("expected clean merge, got " <> show other)++    it "round-trips Unicode changes from both sides" $ withGit $ do+      result <-+        threeWayMerge+          "こんにちは\n共有\n終わり\n"+          "こんにちは\n利用者\n共有\n終わり\n"+          "こんにちは\n共有\nモジュール\n終わり\n"+      case result of+        MergeClean merged -> do+          merged `shouldSatisfy` T.isInfixOf "利用者"+          merged `shouldSatisfy` T.isInfixOf "モジュール"+        other -> expectationFailure ("expected clean merge, got " <> show other)++isUnavailable :: MergeOutcome -> Bool+isUnavailable (MergeUnavailable message) = not (T.null message)+isUnavailable _ = False++withGit :: Expectation -> Expectation+withGit action = do+  available <- gitAvailable+  unless available (pendingWith "git is not available")+  action++gitAvailable :: IO Bool+gitAvailable = isJust <$> findExecutable "git"

@@ -0,0 +1,453 @@+module Seihou.Engine.UpdateTransactionSpec (tests) where++import Control.Exception (throwIO)+import Control.Monad (unless, when)+import Data.ByteString.Lazy qualified as LBS+import Data.Foldable (traverse_)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful (runEff)+import Seihou.Core.Types hiding (KeepCurrent)+import Seihou.Effect.BaselineStore (putBaseline)+import Seihou.Effect.BaselineStoreInterp (runBaselineStore)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Engine.Reconcile+import Seihou.Engine.UpdateTransaction+import Seihou.Manifest.Hash (baselineRefForContent, hashContent)+import Seihou.Manifest.Types (emptyManifest, manifestToJSON)+import System.Directory (findExecutable)+import System.Directory qualified as Directory+import System.FilePath (takeDirectory, (</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.UpdateTransaction" spec++spec :: Spec+spec = do+  describe "applyReconciliation" $ do+    it "writes resolved files and updates baselines, hashes, ownership, and orphans" $+      withSystemTempDirectory "seihou-update-transaction" $ \projectRoot -> do+        writeProject projectRoot "merged.txt" "user\n"+        writeProject projectRoot "safe.txt" "safe\n"+        writeProject projectRoot "edited.txt" "user orphan\n"+        writeProject projectRoot "shared.txt" "shared\n"+        let oldMerged = fileRecord "base\n" (Just (baselineRefForContent "base\n")) [appA]+            oldSafe = fileRecord "safe\n" Nothing [appA]+            oldEdited = fileRecord "before\n" Nothing [appA]+            oldShared = fileRecord "shared\n" Nothing [appA, appB]+            manifest =+              manifestWithFiles+                ( Map.fromList+                    [ ("merged.txt", oldMerged),+                      ("safe.txt", oldSafe),+                      ("edited.txt", oldEdited),+                      ("shared.txt", oldShared)+                    ]+                )+            desired = desiredFile "merged.txt" "generated\n" [appA]+            mergedState = plannedState "generated\n" "user and generated\n" True+            plan =+              ReconciliationPlan+                { applicationIds = Set.singleton appA,+                  files =+                    Map.fromList+                      [ ("merged.txt", FileAutoMerge desired mergedState (observed "user\n") (Just oldMerged)),+                        ("safe.txt", FileDeleteSafe "safe.txt" oldSafe (observed "safe\n")),+                        ( "edited.txt",+                          FileOrphanEdited+                            "edited.txt"+                            oldEdited+                            "user orphan\n"+                            (observed "user orphan\n")+                            (Just RetainTrackedOrphan)+                        ),+                        ("shared.txt", FileReleaseSharedOwnership "shared.txt" oldShared (observed "shared\n"))+                      ],+                  requiredDirectories = Set.empty+                }+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Map.keysSet plan.files)+        candidate <- expectRight =<< applyReconciliation transaction plan manifest++        readProject projectRoot "merged.txt" `shouldReturn` "user and generated\n"+        Directory.doesFileExist (projectRoot </> "safe.txt") `shouldReturn` False+        readProject projectRoot "edited.txt" `shouldReturn` "user orphan\n"+        readProject projectRoot "shared.txt" `shouldReturn` "shared\n"++        let mergedRecord = candidate.files Map.! "merged.txt"+            baseline = baselineRefForContent "generated\n"+        mergedRecord.hash `shouldBe` hashContent "user and generated\n"+        mergedRecord.baseline `shouldBe` Just baseline+        mergedRecord.applicationIds `shouldBe` Set.singleton appA+        Map.member "safe.txt" candidate.files `shouldBe` False+        candidate.files Map.! "edited.txt" `shouldBe` oldEdited+        (candidate.files Map.! "shared.txt").applicationIds `shouldBe` Set.singleton appB+        readProject projectRoot (".seihou/baselines" </> refName baseline) `shouldReturn` "generated\n"++        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` True+        completeUpdateTransaction transaction `shouldReturn` Right ()+        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` False++    it "advances the baseline but preserves disk and applied hash for KeepCurrent" $+      withSystemTempDirectory "seihou-update-keep-current" $ \projectRoot -> do+        writeProject projectRoot "file.txt" "user\n"+        let oldRecord = fileRecord "base\n" (Just (baselineRefForContent "base\n")) [appA]+            desired = desiredFile "file.txt" "generated\n" [appA]+            unresolved =+              FileConflict+                desired+                "user\n"+                "markers\n"+                OverlappingEdits+                (observed "user\n")+                (Just oldRecord)+                Nothing+            initialPlan = ReconciliationPlan (Set.singleton appA) (Map.singleton "file.txt" unresolved) Set.empty+            manifest = manifestWithFiles (Map.singleton "file.txt" oldRecord)+        resolvedPlan <- expectRight (resolveFileConflict "file.txt" KeepCurrent initialPlan)+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Set.singleton "file.txt")+        candidate <- expectRight =<< applyReconciliation transaction resolvedPlan manifest+        readProject projectRoot "file.txt" `shouldReturn` "user\n"+        let resultRecord = candidate.files Map.! "file.txt"+        resultRecord.hash `shouldBe` hashContent "user\n"+        resultRecord.baseline `shouldBe` Just (baselineRefForContent "generated\n")+        completeUpdateTransaction transaction `shouldReturn` Right ()++    it "rejects a stale plan before its first mutation" $+      withSystemTempDirectory "seihou-update-stale" $ \projectRoot -> do+        writeProject projectRoot "file.txt" "planned\n"+        let desired = desiredFile "file.txt" "new\n" [appA]+            plan =+              ReconciliationPlan+                (Set.singleton appA)+                (Map.singleton "file.txt" (FileUpdate desired (plannedState "new\n" "new\n" True) (observed "old\n") Nothing))+                Set.empty+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Set.singleton "file.txt")+        result <- applyReconciliation transaction plan (manifestWithFiles Map.empty)+        result `shouldSatisfy` isStale+        readProject projectRoot "file.txt" `shouldReturn` "planned\n"+        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` False++    it "deletes or detaches edited orphans only after explicit resolution" $+      withSystemTempDirectory "seihou-update-orphan-resolution" $ \projectRoot -> do+        writeProject projectRoot "delete.txt" "user delete\n"+        writeProject projectRoot "detach.txt" "user detach\n"+        let deleteRecord = fileRecord "old delete\n" Nothing [appA]+            detachRecord = fileRecord "old detach\n" Nothing [appA]+            plan =+              ReconciliationPlan+                (Set.singleton appA)+                ( Map.fromList+                    [ ( "delete.txt",+                        FileOrphanEdited+                          "delete.txt"+                          deleteRecord+                          "user delete\n"+                          (observed "user delete\n")+                          (Just DeleteEditedOrphan)+                      ),+                      ( "detach.txt",+                        FileOrphanEdited+                          "detach.txt"+                          detachRecord+                          "user detach\n"+                          (observed "user detach\n")+                          (Just DetachAndKeepOrphan)+                      )+                    ]+                )+                Set.empty+            manifest = manifestWithFiles (Map.fromList [("delete.txt", deleteRecord), ("detach.txt", detachRecord)])+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Map.keysSet plan.files)+        candidate <- expectRight =<< applyReconciliation transaction plan manifest+        Directory.doesFileExist (projectRoot </> "delete.txt") `shouldReturn` False+        readProject projectRoot "detach.txt" `shouldReturn` "user detach\n"+        candidate.files `shouldBe` Map.empty+        completeUpdateTransaction transaction `shouldReturn` Right ()++    it "refuses unresolved plans without touching disk" $+      withSystemTempDirectory "seihou-update-unresolved" $ \projectRoot -> do+        writeProject projectRoot "file.txt" "user\n"+        let desired = desiredFile "file.txt" "generated\n" [appA]+            conflict =+              FileConflict desired "user\n" "markers\n" OverlappingEdits (observed "user\n") Nothing Nothing+            plan = ReconciliationPlan (Set.singleton appA) (Map.singleton "file.txt" conflict) Set.empty+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Set.singleton "file.txt")+        result <- applyReconciliation transaction plan (manifestWithFiles Map.empty)+        result `shouldSatisfy` isUnresolved+        readProject projectRoot "file.txt" `shouldReturn` "user\n"+        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` False++  describe "rollback and recovery" $ do+    it "rolls every earlier mutation back after an injected failure" $+      withSystemTempDirectory "seihou-update-rollback" $ \projectRoot -> do+        writeProject projectRoot "one.txt" "old one\n"+        writeProject projectRoot "two.txt" "old two\n"+        let one = desiredFile "one.txt" "new one\n" [appA]+            two = desiredFile "two.txt" "new two\n" [appA]+            plan =+              ReconciliationPlan+                (Set.singleton appA)+                ( Map.fromList+                    [ ("one.txt", FileUpdate one (plannedState "new one\n" "new one\n" True) (observed "old one\n") Nothing),+                      ("two.txt", FileUpdate two (plannedState "new two\n" "new two\n" True) (observed "old two\n") Nothing)+                    ]+                )+                Set.empty+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Map.keysSet plan.files)+        result <-+          applyReconciliationWithHook+            (\count -> when (count == 1) (throwIO (userError "injected failure")))+            transaction+            plan+            (manifestWithFiles Map.empty)+        result `shouldSatisfy` isApplyFailure+        readProject projectRoot "one.txt" `shouldReturn` "old one\n"+        readProject projectRoot "two.txt" `shouldReturn` "old two\n"+        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` False++    it "restores a well-formed leftover journal on startup" $+      withSystemTempDirectory "seihou-update-recover" $ \projectRoot -> do+        writeProject projectRoot "file.txt" "old\n"+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Set.singleton "file.txt")+        writeProject projectRoot "file.txt" "interrupted\n"+        recoverIncompleteTransactions projectRoot `shouldReturn` [Right ()]+        readProject projectRoot "file.txt" `shouldReturn` "old\n"+        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` False++    it "recovers an applied but unpublished candidate and removes its new empty directories" $+      withSystemTempDirectory "seihou-update-unpublished" $ \projectRoot -> do+        writeProject projectRoot "file.txt" "old\n"+        let desired = desiredFile "file.txt" "new\n" [appA]+            plan =+              ReconciliationPlan+                (Set.singleton appA)+                (Map.singleton "file.txt" (FileUpdate desired (plannedState "new\n" "new\n" True) (observed "old\n") Nothing))+                (Set.singleton "empty/generated")+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Set.singleton "file.txt")+        _candidate <- expectRight =<< applyReconciliation transaction plan (manifestWithFiles Map.empty)+        readProject projectRoot "file.txt" `shouldReturn` "new\n"+        Directory.doesDirectoryExist (projectRoot </> "empty" </> "generated") `shouldReturn` True+        recoverIncompleteTransactions projectRoot `shouldReturn` [Right ()]+        readProject projectRoot "file.txt" `shouldReturn` "old\n"+        Directory.doesDirectoryExist (projectRoot </> "empty") `shouldReturn` False+        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` False++    it "keeps committed files when the durable manifest matches the journal" $+      withSystemTempDirectory "seihou-update-committed" $ \projectRoot -> do+        writeProject projectRoot "file.txt" "old\n"+        let desired = desiredFile "file.txt" "new\n" [appA]+            plan =+              ReconciliationPlan+                (Set.singleton appA)+                (Map.singleton "file.txt" (FileUpdate desired (plannedState "new\n" "new\n" True) (observed "old\n") Nothing))+                Set.empty+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Set.singleton "file.txt")+        candidate <- expectRight =<< applyReconciliation transaction plan (manifestWithFiles Map.empty)+        Directory.createDirectoryIfMissing True (projectRoot </> ".seihou")+        LBS.writeFile (projectRoot </> ".seihou" </> "manifest.json") (manifestToJSON candidate)+        recoverIncompleteTransactions projectRoot `shouldReturn` [Right ()]+        readProject projectRoot "file.txt" `shouldReturn` "new\n"+        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` False++    it "uses an orchestrator's complete final manifest as the recovery commit marker" $+      withSystemTempDirectory "seihou-update-final-marker" $ \projectRoot -> do+        writeProject projectRoot "file.txt" "old\n"+        let desired = desiredFile "file.txt" "new\n" [appA]+            plan =+              ReconciliationPlan+                (Set.singleton appA)+                (Map.singleton "file.txt" (FileUpdate desired (plannedState "new\n" "new\n" True) (observed "old\n") Nothing))+                Set.empty+        transaction <- expectRight =<< beginUpdateTransaction projectRoot (Set.singleton "file.txt")+        candidate <- expectRight =<< applyReconciliation transaction plan (manifestWithFiles Map.empty)+        let finalManifest :: Manifest+            finalManifest =+              Manifest+                { version = candidate.version,+                  genAt = candidate.genAt,+                  modules = candidate.modules,+                  vars = Map.singleton "published" "yes",+                  files = candidate.files,+                  applications = candidate.applications,+                  recipe = candidate.recipe,+                  blueprint = candidate.blueprint,+                  blueprintMigrations = candidate.blueprintMigrations+                }+        setUpdateTransactionExpectedManifest transaction finalManifest `shouldReturn` Right ()+        Directory.createDirectoryIfMissing True (projectRoot </> ".seihou")+        LBS.writeFile (projectRoot </> ".seihou" </> "manifest.json") (manifestToJSON finalManifest)+        recoverIncompleteTransactions projectRoot `shouldReturn` [Right ()]+        readProject projectRoot "file.txt" `shouldReturn` "new\n"+        Directory.doesDirectoryExist transaction.transactionDirectory `shouldReturn` False++    it "quarantines malformed journal metadata instead of deleting it" $+      withSystemTempDirectory "seihou-update-malformed" $ \projectRoot -> do+        let transactionDirectory = projectRoot </> ".seihou" </> "transactions" </> "broken"+            quarantineDirectory = projectRoot </> ".seihou" </> "transactions-quarantine" </> "broken"+        Directory.createDirectoryIfMissing True transactionDirectory+        TIO.writeFile (transactionDirectory </> "journal.json") "{ not json"+        results <- recoverIncompleteTransactions projectRoot+        results `shouldSatisfy` singleMalformed+        Directory.doesDirectoryExist transactionDirectory `shouldReturn` False+        Directory.doesDirectoryExist quarantineDirectory `shouldReturn` True++  describe "path validation" $ do+    it "rejects traversal, absolute, Git, and Seihou targets" $+      withSystemTempDirectory "seihou-update-validation" $ \projectRoot -> do+        traversal <- beginUpdateTransaction projectRoot (Set.singleton "../escape")+        absolute <- beginUpdateTransaction projectRoot (Set.singleton (projectRoot </> "escape"))+        gitPath <- beginUpdateTransaction projectRoot (Set.singleton ".git/config")+        windowsGitPath <- beginUpdateTransaction projectRoot (Set.singleton ".git\\config")+        seihouPath <- beginUpdateTransaction projectRoot (Set.singleton ".seihou/manifest.json")+        traverse_ (`shouldSatisfy` isInvalid) [traversal, absolute, gitPath, windowsGitPath, seihouPath]++  describe "disposable project fixture" $ do+    it "merges user and generated edits, deletes a safe orphan, and retains an edited orphan" $+      withGit $+        withSystemTempDirectory "seihou-update-fixture" $ \projectRoot -> do+          let baseline = "title\nshared\nfooter\n"+              current = "title\nuser\nshared\nfooter\n"+              generated = "title\nshared\nmodule\nfooter\n"+              baselineDirectory = projectRoot </> ".seihou" </> "baselines"+          writeProject projectRoot "merged.txt" current+          writeProject projectRoot "safe.txt" "safe\n"+          writeProject projectRoot "edited.txt" "user orphan\n"+          baselineRef <- runEff $ runFilesystem $ runBaselineStore baselineDirectory (putBaseline baseline)+          let mergedRecord = fileRecord baseline (Just baselineRef) [appA]+              safeRecord = fileRecord "safe\n" Nothing [appA]+              editedRecord = fileRecord "old orphan\n" Nothing [appA]+              manifest =+                manifestWithFiles+                  ( Map.fromList+                      [ ("merged.txt", mergedRecord),+                        ("safe.txt", safeRecord),+                        ("edited.txt", editedRecord)+                      ]+                  )+              operations = [WriteFileOp "merged.txt" generated Template]+              ownerMap = Map.singleton "merged.txt" (DesiredFileOwner "owner" (Set.singleton appA))+          planned <-+            runEff $+              runFilesystem $+                runBaselineStore baselineDirectory $+                  planReconciliation projectRoot manifest (Set.singleton appA) operations ownerMap+          initialPlan <- expectRight planned+          resolvedPlan <- expectRight (resolveEditedOrphan "edited.txt" RetainTrackedOrphan initialPlan)+          reconciliationSummary resolvedPlan `shouldBe` ReconciliationSummary 0 0 1 0 0 1 1 0++          transaction <- expectRight =<< beginUpdateTransaction projectRoot (reconciliationMutationPaths resolvedPlan)+          candidate <- expectRight =<< applyReconciliation transaction resolvedPlan manifest+          completeUpdateTransaction transaction `shouldReturn` Right ()++          merged <- readProject projectRoot "merged.txt"+          merged `shouldSatisfy` T.isInfixOf "user"+          merged `shouldSatisfy` T.isInfixOf "module"+          Directory.doesFileExist (projectRoot </> "safe.txt") `shouldReturn` False+          readProject projectRoot "edited.txt" `shouldReturn` "user orphan\n"+          Map.member "safe.txt" candidate.files `shouldBe` False+          Map.member "edited.txt" candidate.files `shouldBe` True+          Directory.listDirectory (projectRoot </> ".seihou" </> "transactions") `shouldReturn` []++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-19T12:00:00Z"++appA, appB :: ApplicationId+appA = ApplicationId "app-a"+appB = ApplicationId "app-b"++manifestWithFiles :: Map.Map FilePath FileRecord -> Manifest+manifestWithFiles fileRecords =+  let manifest = emptyManifest fixedTime+   in Manifest+        { version = manifest.version,+          genAt = manifest.genAt,+          modules = manifest.modules,+          vars = manifest.vars,+          files = fileRecords,+          applications = manifest.applications,+          recipe = manifest.recipe,+          blueprint = manifest.blueprint,+          blueprintMigrations = manifest.blueprintMigrations+        }++fileRecord :: Text -> Maybe BaselineRef -> [ApplicationId] -> FileRecord+fileRecord content baseline owners =+  FileRecord+    { hash = hashContent content,+      moduleName = "owner",+      strategy = Template,+      generatedAt = fixedTime,+      baseline = baseline,+      applicationIds = Set.fromList owners+    }++desiredFile :: FilePath -> Text -> [ApplicationId] -> DesiredFile+desiredFile path content owners =+  DesiredFile+    { path = path,+      generatedContent = content,+      moduleName = "owner",+      strategy = Template,+      applicationIds = Set.fromList owners+    }++plannedState :: Text -> Text -> Bool -> PlannedFileState+plannedState baseline applied shouldWrite =+  PlannedFileState+    { generatedBaseline = baseline,+      appliedContent = applied,+      recordedHash = hashContent applied,+      writeToDisk = shouldWrite+    }++observed :: Text -> ObservedFile+observed content = ObservedFile True (Just (hashContent content))++writeProject :: FilePath -> FilePath -> Text -> IO ()+writeProject projectRoot relativePath content = do+  Directory.createDirectoryIfMissing True (projectRoot </> takeDirectory relativePath)+  TIO.writeFile (projectRoot </> relativePath) content++readProject :: FilePath -> FilePath -> IO Text+readProject projectRoot relativePath = TIO.readFile (projectRoot </> relativePath)++refName :: BaselineRef -> FilePath+refName reference = T.unpack reference.unBaselineRef.unSHA256++expectRight :: (Show error) => Either error value -> IO value+expectRight (Right value) = pure value+expectRight (Left err) = expectationFailure (show err) >> fail (show err)++isStale :: Either TransactionError Manifest -> Bool+isStale (Left (TransactionStalePlan _ _ _)) = True+isStale _ = False++isApplyFailure :: Either TransactionError Manifest -> Bool+isApplyFailure (Left (TransactionApplyFailed _ _)) = True+isApplyFailure _ = False++isUnresolved :: Either TransactionError Manifest -> Bool+isUnresolved (Left (TransactionUnresolvedPaths paths)) = paths == Set.singleton "file.txt"+isUnresolved _ = False++singleMalformed :: [Either TransactionError ()] -> Bool+singleMalformed [Left (TransactionJournalMalformed _ _)] = True+singleMalformed _ = False++isInvalid :: Either TransactionError UpdateTransaction -> Bool+isInvalid (Left (InvalidTransactionPath _ _)) = True+isInvalid _ = False++withGit :: Expectation -> Expectation+withGit action = do+  available <- maybe False (const True) <$> findExecutable "git"+  unless available (pendingWith "git is not available")+  action

@@ -62,7 +62,11 @@           genAt = base.genAt,           modules = base.modules,           vars = base.vars,-          files = recs+          files = recs,+          applications = base.applications,+          recipe = base.recipe,+          blueprint = base.blueprint,+          blueprintMigrations = base.blueprintMigrations         }  -- | Extract planned files from operations for computeDiff.

@@ -4,7 +4,7 @@ import Data.Text (Text) import Effectful import Seihou.Composition.Instance (primaryInstance)-import Seihou.Composition.Resolve (resolveWithPrompts)+import Seihou.Composition.Resolve (PromptPermission (..), resolveWithPromptPermission, resolveWithPrompts) import Seihou.Core.Types import Seihou.Effect.ConsolePure import Seihou.Interaction.Prompt (promptForVar, runPrompts)@@ -326,6 +326,23 @@           _ -> expectationFailure $ "Expected exactly 1 error, got: " ++ show (length errs)         Right _ -> expectationFailure "Expected Left (errors), got Right"       -- No prompts should have been displayed+      st.consoleOutputs `shouldSatisfy` all (/= "What is the project name?")++    it "forbids prompts even when the Console interpreter is interactive" $ do+      let m =+            mkModule+              "base"+              []+              [mkTextVar "project.name" Nothing True]+              []+              [mkPrompt "project.name" "What is the project name?"]+          modules = [(primaryInstance m.name, m, "/fake/base")]+      (result, st) <-+        runEff $+          runConsolePure ["must-not-be-read"] $+            resolveWithPromptPermission PromptsForbidden modules Map.empty Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      result `shouldBe` Left [MissingRequiredVar "project.name"]+      st.consoleInputs `shouldBe` ["must-not-be-read"]       st.consoleOutputs `shouldSatisfy` all (/= "What is the project name?")      it "prompts for optional variables after required resolution" $ do

@@ -2,6 +2,7 @@  import Data.Aeson qualified as Aeson import Data.Map.Strict qualified as Map+import Data.Set qualified as Set import Data.Text qualified as T import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError) import Seihou.Core.Types@@ -21,10 +22,21 @@ fixedTime2 :: UTCTime fixedTime2 = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T11:00:00Z" +mkBlueprintMigrationReceipt :: T.Text -> T.Text -> T.Text -> UTCTime -> AppliedBlueprintMigration+mkBlueprintMigrationReceipt blueprintName fromVersion toVersion appliedAt =+  AppliedBlueprintMigration+    { name = ModuleName blueprintName,+      blueprintVersion = Just "0.4.0",+      fromVersion = fromVersion,+      toVersion = toVersion,+      appliedAt = appliedAt,+      agentSessionId = Nothing+    }+ -- | Helper to set modules on a Manifest without ambiguous record update. withManifestModules :: [AppliedModule] -> Manifest -> Manifest withManifestModules mods m =-  Manifest m.version m.genAt mods m.vars m.files m.recipe m.blueprint+  Manifest m.version m.genAt mods m.vars m.files m.applications m.recipe m.blueprint m.blueprintMigrations  spec :: Spec spec = do@@ -32,13 +44,14 @@     it "creates a manifest with the current version" $ do       let m = emptyManifest fixedTime       m.version `shouldBe` currentManifestVersion-      m.version `shouldBe` 3+      m.version `shouldBe` 5      it "creates a manifest with no modules, vars, or files" $ do       let m = emptyManifest fixedTime       m.modules `shouldBe` []       m.vars `shouldBe` Map.empty       m.files `shouldBe` Map.empty+      m.blueprintMigrations `shouldBe` []    describe "JSON roundtrip" $ do     it "roundtrips an empty manifest" $ do@@ -73,8 +86,10 @@                       (VarName "license", "MIT")                     ],                 files = base.files,+                applications = base.applications,                 recipe = Nothing,-                blueprint = Nothing+                blueprint = Nothing,+                blueprintMigrations = []               }       manifestFromJSON (manifestToJSON m) `shouldBe` Right m @@ -89,7 +104,9 @@                           { hash = SHA256 "abc123",                             moduleName = ModuleName "haskell-base",                             strategy = Template,-                            generatedAt = fixedTime+                            generatedAt = fixedTime,+                            baseline = Nothing,+                            applicationIds = mempty                           }                       ),                       ( "my-app.cabal",@@ -97,7 +114,9 @@                           { hash = SHA256 "def456",                             moduleName = ModuleName "haskell-base",                             strategy = DhallText,-                            generatedAt = fixedTime+                            generatedAt = fixedTime,+                            baseline = Nothing,+                            applicationIds = mempty                           }                       )                     ]@@ -121,21 +140,23 @@                 files =                   Map.fromList                     [ ( "README.md",-                        FileRecord (SHA256 "aaa") (ModuleName "haskell-base") Template fixedTime+                        FileRecord (SHA256 "aaa") (ModuleName "haskell-base") Template fixedTime Nothing mempty                       ),                       ( "LICENSE",-                        FileRecord (SHA256 "bbb") (ModuleName "haskell-base") Copy fixedTime+                        FileRecord (SHA256 "bbb") (ModuleName "haskell-base") Copy fixedTime Nothing mempty                       )                     ],+                applications = [],                 recipe = Nothing,-                blueprint = Nothing+                blueprint = Nothing,+                blueprintMigrations = []               }       manifestFromJSON (manifestToJSON m) `shouldBe` Right m      it "roundtrips all strategy types" $ do       let strategies = [Copy, Template, DhallText, Structured]           makeRecord s =-            FileRecord (SHA256 "hash") (ModuleName "mod") s fixedTime+            FileRecord (SHA256 "hash") (ModuleName "mod") s fixedTime Nothing mempty           m :: Manifest           m =             (emptyManifest fixedTime)@@ -200,6 +221,72 @@               (emptyManifest fixedTime)       manifestFromJSON (manifestToJSON m) `shouldBe` Right m +    it "roundtrips all version-4 application and update state" $ do+      let appId1 = ApplicationId "application-one"+          appId2 = ApplicationId "application-two"+          fingerprint = CommandFingerprint (SHA256 "command-hash")+          receipt =+            CommandReceipt+              { fingerprint = fingerprint,+                moduleName = ModuleName "master-plan",+                command = "cabal test all",+                workDir = Just "cli",+                completedAt = fixedTime2+              }+          pv1 = ParentVars (Map.singleton (VarName "skill.name") "exec-plan")+          pv2 = ParentVars (Map.singleton (VarName "skill.name") "master-plan")+          application1 =+            AppliedComposition+              { applicationId = appId1,+                target = AppliedModuleTarget (ModuleName "master-plan"),+                targetSource = "/modules/master-plan",+                targetVersion = Just "0.7.0",+                additionalModules = [ModuleName "docs"],+                namespace = Just "planning",+                context = Just "work",+                instances =+                  [ AppliedInstanceState (ModuleName "link-skill") pv1 "/modules/link-skill" (Just "1") (Map.singleton (VarName "skill.name") "exec-plan"),+                    AppliedInstanceState (ModuleName "link-skill") pv2 "/modules/link-skill" (Just "1") (Map.singleton (VarName "skill.name") "master-plan")+                  ],+                commandReceipts = Map.singleton fingerprint receipt,+                appliedAt = fixedTime+              }+          application2 =+            AppliedComposition+              { applicationId = appId2,+                target = AppliedRecipeTarget (RecipeName "service"),+                targetSource = "/recipes/service",+                targetVersion = Nothing,+                additionalModules = [],+                namespace = Nothing,+                context = Nothing,+                instances = [],+                commandReceipts = Map.empty,+                appliedAt = fixedTime2+              }+          fileRecord =+            FileRecord+              { hash = SHA256 "applied-hash",+                moduleName = ModuleName "master-plan",+                strategy = Template,+                generatedAt = fixedTime,+                baseline = Just (BaselineRef (hashContent "generated baseline")),+                applicationIds = Set.fromList [appId1, appId2]+              }+          manifest =+            (emptyManifest fixedTime)+              { applications = [application1, application2],+                files = Map.singleton "README.md" fileRecord+              }+      manifestFromJSON (manifestToJSON manifest) `shouldBe` Right manifest++    it "rejects malformed baseline references" $ do+      let json =+            "{\"version\":4,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[],\"variables\":{},"+              <> "\"files\":{\"README.md\":{\"hash\":\"abc\",\"module\":\"legacy\",\"strategy\":\"template\","+              <> "\"generatedAt\":\"2026-03-01T10:30:00Z\",\"baseline\":\"../manifest.json\"}}}"+      manifestFromJSON json `shouldSatisfy` either (const True) (const False)+   describe "AppliedBlueprint" $ do     it "round-trips a fully populated entry through JSON" $ do       let ab =@@ -252,7 +339,82 @@       m1.blueprint `shouldBe` Just ab1       m2.blueprint `shouldBe` Just ab2 +  describe "AppliedBlueprintMigration" $ do+    it "round-trips a fully populated receipt through JSON" $ do+      let receipt =+            AppliedBlueprintMigration+              (ModuleName "payments")+              (Just "0.4.0")+              "1.0.0"+              "2.0.0"+              fixedTime+              (Just "session-123")+      Aeson.eitherDecode (Aeson.encode receipt) `shouldBe` Right receipt++    it "round-trips a version-5 manifest containing a receipt" $ do+      let receipt = mkBlueprintMigrationReceipt "payments" "1.0.0" "2.0.0" fixedTime+          manifest = (emptyManifest fixedTime) {blueprintMigrations = [receipt]}+      manifestFromJSON (manifestToJSON manifest) `shouldBe` Right manifest++    it "replaces the same exact edge in place and appends a different edge" $ do+      let first = mkBlueprintMigrationReceipt "payments" "1.0.0" "2.0.0" fixedTime+          unrelated = mkBlueprintMigrationReceipt "payments" "2.5.0" "3.0.0" fixedTime+          replacement =+            AppliedBlueprintMigration+              (ModuleName "payments")+              (Just "0.5.0")+              "1.0.0"+              "2.0.0"+              fixedTime2+              (Just "rerun")+          manifest1 = writeAppliedBlueprintMigration unrelated (writeAppliedBlueprintMigration first (emptyManifest fixedTime))+          manifest2 = writeAppliedBlueprintMigration replacement manifest1+      manifest2.blueprintMigrations `shouldBe` [replacement, unrelated]+      hasAppliedBlueprintMigration "payments" "1.0.0" "2.0.0" manifest2 `shouldBe` True+      hasAppliedBlueprintMigration "payments" "2.0.0" "3.0.0" manifest2 `shouldBe` False++    it "preserves modules, applications, files, recipe, and normal blueprint provenance" $ do+      let appliedModule = AppliedModule "base" emptyParentVars "/installed/base" (Just "1.0.0") fixedTime Nothing+          application =+            AppliedComposition+              { applicationId = ApplicationId "app-base",+                target = AppliedModuleTarget "base",+                targetSource = "/installed/base",+                targetVersion = Just "1.0.0",+                additionalModules = [],+                namespace = Nothing,+                context = Nothing,+                instances = [],+                commandReceipts = Map.empty,+                appliedAt = fixedTime+              }+          fileRecord = FileRecord (SHA256 "hash") "base" Template fixedTime Nothing mempty+          recipe = AppliedRecipe "recipe" (Just "1.0.0") fixedTime+          normalBlueprint = AppliedBlueprint "payments" (Just "0.4.0") fixedTime [] False Nothing Nothing+          seed =+            (emptyManifest fixedTime)+              { modules = [appliedModule],+                applications = [application],+                files = Map.singleton "README.md" fileRecord,+                recipe = Just recipe,+                blueprint = Just normalBlueprint+              }+          updated = writeAppliedBlueprintMigration (mkBlueprintMigrationReceipt "payments" "1.0.0" "2.0.0" fixedTime) seed+      updated.modules `shouldBe` seed.modules+      updated.applications `shouldBe` seed.applications+      updated.files `shouldBe` seed.files+      updated.recipe `shouldBe` seed.recipe+      updated.blueprint `shouldBe` seed.blueprint+   describe "schema back-compat" $ do+    it "decodes a v4 manifest with no blueprintMigrations key as an empty ledger" $ do+      let json = "{\"version\":4,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[],\"variables\":{},\"files\":{},\"applications\":[]}"+      case manifestFromJSON json of+        Right manifest -> do+          manifest.version `shouldBe` 4+          manifest.blueprintMigrations `shouldBe` []+        Left err -> expectationFailure ("failed to parse v4 manifest: " <> err)+     -- A pre-EP-32 (schema v2) manifest has no @blueprint@ key. The     -- decoder must read it as 'Nothing' regardless of the version     -- field, so a pre-bump project does not refuse to load after the@@ -271,6 +433,20 @@         Right manifest -> manifest.blueprint `shouldBe` Nothing         Left err -> expectationFailure ("failed to parse: " <> err) +    it "decodes a v3 manifest with empty defaults for every version-4 field" $ do+      let json =+            "{\"version\":3,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[],\"variables\":{},"+              <> "\"files\":{\"README.md\":{\"hash\":\"abc\",\"module\":\"legacy\",\"strategy\":\"template\",\"generatedAt\":\"2026-03-01T10:30:00Z\"}}}"+      case manifestFromJSON json of+        Right manifest -> do+          manifest.applications `shouldBe` []+          case Map.lookup "README.md" manifest.files of+            Just record -> do+              record.baseline `shouldBe` Nothing+              record.applicationIds `shouldBe` Set.empty+            Nothing -> expectationFailure "expected legacy file record"+        Left err -> expectationFailure ("failed to parse: " <> err)+     it "decodes a v3 manifest with a populated blueprint object" $ do       let json =             "{\"version\":3,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[],\"variables\":{},\"files\":{},"@@ -307,7 +483,7 @@   describe "version checking" $ do     it "rejects manifests with version higher than current" $ do       let base = emptyManifest fixedTime-          m = Manifest {version = 99, genAt = base.genAt, modules = base.modules, vars = base.vars, files = base.files, recipe = Nothing, blueprint = Nothing}+          m = Manifest {version = 99, genAt = base.genAt, modules = base.modules, vars = base.vars, files = base.files, applications = base.applications, recipe = Nothing, blueprint = Nothing, blueprintMigrations = []}           result = manifestFromJSON (manifestToJSON m)       case result of         Left err -> err `shouldContain` "newer version"