packages feed

seihou-cli 0.4.0.0 → 0.5.0.0

raw patch · 57 files changed

+8006/−417 lines, 57 filesdep ~baikaidep ~baikai-claudedep ~baikai-kit

Dependency ranges changed: baikai, baikai-claude, baikai-kit, baikai-openai, seihou-core

Files

+ data/blueprint-migration-prompt.md view
@@ -0,0 +1,76 @@+You are running one ordered Seihou blueprint migration for a library upgrade.+The blueprint author supplied shared library guidance plus instructions for this+exact version edge. Work only on the current edge; later edges run in separate+agent sessions after this one succeeds.++You may be running in an interactive local CLI with repository tools, or as a+one-shot API completion without tools. When tools are available, inspect the+project's actual use of the library, edit the repository directly, and run the+relevant validation. When tools are unavailable, return concrete guidance,+patch-style snippets, and validation commands the user can apply.+++## Current Environment++Working directory: {{cwd}}+{{seihou_project_state}}+{{manifest_state}}+{{module_dhall_state}}+{{local_modules}}+{{available_modules}}+++## Blueprint Identity++Name: {{blueprint_name}}+Version: {{blueprint_version}}+Description: {{blueprint_description}}+++## Migration Edge++Step {{migration_position}} of {{migration_total}}+From library version: {{migration_from}}+To library version: {{migration_to}}+++## Reference Files++The blueprint declares these shared library-upgrade references:++{{reference_files}}++{{reference_files_dir}}+++## Shared Blueprint Guidance++{{shared_prompt}}+++## Instructions for This Edge++{{migration_prompt}}+++## Workflow++1. Inspect how the project actually uses the library at the source version.+   Do not assume every API named in the guidance is present.+2. Read relevant mounted reference files when available. If they are not+   mounted, ask the user for anything essential and never claim to have read it.+3. Make only the changes needed for {{migration_from}} -> {{migration_to}}.+   Preserve unrelated user changes and do not pre-apply later migration edges.+4. Update source, configuration, and tests that are directly affected by this+   edge. Avoid broad cleanup unrelated to the upgrade.+5. Run the most relevant project validation available for this library change.+   Report checks you could not run and why.+6. Before exiting, summarize changed files, validation results, and any work+   that remains for the user or later migration steps.+++## Completion Boundary++Seihou records this exact edge after your provider interaction returns+successfully. That receipt is not package-manager verification. Do not report+the target version as installed unless you actually verified it in the project.
help/agent.md view
@@ -2,8 +2,8 @@  `seihou agent` renders Seihou-aware prompts and starts a configured provider. The agent commands are for AI-assisted-module authoring, bootstrapping, project setup, and running-agent-driven blueprints.+module authoring, bootstrapping, project setup, running agent-driven+blueprints, and applying ordered blueprint library migrations.  CLI providers open interactive local Claude Code or Codex sessions. API providers send one rendered prompt as a batch completion and print@@ -25,7 +25,7 @@    --model MODEL       Select a provider-specific model name or alias for this-      invocation.+      invocation. Run `seihou agent models` to list known choices.  Provider and model options may appear on the parent command or on the subcommand:@@ -81,6 +81,22 @@  SUBCOMMANDS +  seihou agent models [--provider PROVIDER]+      List the Anthropic and OpenAI models in Seihou's compiled Baikai+      catalog. Filtering by `anthropic` or `claude-cli` returns the same+      Claude-family models; filtering by `openai` or `codex-cli` returns+      the same OpenAI-family models. The filter may appear before or+      after `models`:++        seihou agent --provider claude-cli models+        seihou agent models --provider openai++      Listing models requires no provider credentials, network access,+      or agent configuration. The catalog is a discovery aid, not+      validation: provider-native aliases and custom model IDs remain+      accepted by `--model`. Do not pass `--model` to this listing+      command.+   seihou agent assist [PROMPT]       Render a prompt for creating or modifying Seihou modules. The       prompt includes current project context, available modules, and@@ -102,6 +118,17 @@       provider. A successful non-debug run records applied-blueprint       provenance in `.seihou/manifest.json`. +  seihou agent migrate BLUEPRINT --from VERSION --to VERSION [PROMPT]+      Run one agent session per in-window migration declared by the blueprint.+      Versions are explicit dotted numbers; gaps are allowed. Successful edges+      are recorded immediately so a later invocation resumes at the first+      unrecorded edge. `--rerun` ignores matching receipts. Migration mode does+      not apply baseModules and exposes neither --no-baseline nor --force.++      Parent --debug prints every pending migration prompt in order without+      contacting a provider or writing receipts. A receipt records provider+      completion, not package-manager verification.+   seihou prompt run PROMPT [USER-PROMPT] [--var KEY=VALUE] [--debug]       Resolve a reusable prompt, run command-derived variables, render       the prompt body, and send it to the configured provider. Prompts@@ -113,6 +140,7 @@   seihou agent --debug --provider codex-cli bootstrap --repo "inspect this prompt"   seihou agent --debug --provider openai setup "inspect this prompt"   seihou agent --debug run my-blueprint --var project.name=demo+  seihou agent --debug migrate my-library --from 1.0.0 --to 3.0.0  SEE ALSO
help/blueprints.md view
@@ -3,7 +3,8 @@ A blueprint is an agent-driven runnable artifact. Modules and recipes use Seihou's deterministic execution engine to write files from declared steps. Blueprints instead package a prompt, optional baseline modules, variables,-and reference files for `seihou agent run`.+and reference files for `seihou agent run`. They can also package ordered+library-upgrade prompts for `seihou agent migrate`.  Use a blueprint when the desired output needs judgement, iteration, or project-specific design decisions that do not fit a fixed module template.@@ -39,6 +40,7 @@     files          Reference files under the blueprint's files/ directory.     allowedTools   Extra tools to pre-approve in addition to the base set.     tags           Optional discovery tags.+    migrations     Agent-guided library version edges (from, to, prompt).    Blueprints share the same name lookup namespace as modules and recipes.   If a directory contains more than one runnable definition, lookup prefers@@ -103,6 +105,37 @@   its workspace-write sandbox and on-request approval policy because it has no   equivalent per-tool allow-list option. +LIBRARY UPGRADE MIGRATIONS++  A blueprint migration describes one forward dotted-numeric version edge:++    migrations =+      [ S.BlueprintMigration::{+        , from = "1.0.0"+        , to = "2.0.0"+        , prompt = ./migrations/1-to-2.md as Text+        }+      , S.BlueprintMigration::{+        , from = "2.5.0"+        , to = "3.0.0"+        , prompt = ./migrations/2-5-to-3.md as Text+        }+      ]++  Run an installed library blueprint with explicit versions:++    seihou agent migrate my-library --from 1.0.0 --to 3.0.0++  Edges run in ascending `from` order and gaps are allowed. Duplicate starts+  are invalid; overlaps already passed by the cursor and edges overshooting the+  target are skipped. Each successful provider interaction writes an exact-edge+  receipt before the next session. Rerunning resumes; --rerun repeats matching+  receipts. Parent --debug prints pending prompts without launching or writing.++  Migration mode reuses variables, shared prompt, references, and allowed tools,+  but never applies baseModules. A receipt records agent completion, not proof+  that a package manager now reports the target version.+ COMMON COMMANDS    seihou new-blueprint api-service       Scaffold a blueprint@@ -110,6 +143,7 @@   seihou list                            List modules, recipes, blueprints, and prompts   seihou vars api-service                Show blueprint variables   seihou agent run api-service           Run the blueprint with an agent+  seihou agent migrate my-library --from 1.0.0 --to 3.0.0    `seihou run api-service` refuses when `api-service` resolves to a blueprint.   That command is reserved for deterministic modules and recipes; use@@ -126,6 +160,7 @@     - prompts reference declared variables     - baseModules resolve to modules or recipes     - declared reference files exist under files/+    - migrations have dotted forward versions, unique starts, and non-empty prompts    If validation fails, fix the reported check before publishing or running   the blueprint.
help/git-repository.md view
@@ -79,10 +79,14 @@     seihou agent bootstrap                    # single module     seihou agent bootstrap --repo             # multi-module with registry -UPGRADE WORKFLOW+PROJECT UPDATE AND CACHE UPGRADE -  Once installed, modules can be upgraded with `seihou upgrade`. If a newer-  module version ships migrations (for renames,-  deletions, etc.), the upgrade command surfaces them via an advisory; running-  `seihou migrate <module>` is the post-upgrade step that applies them-  to the current project. See `seihou help migrations`.+  After a module or recipe has been applied to a project, use `seihou update`+  for routine source updates. It stages the newer repository content, reuses+  saved inputs, applies migrations, reconciles generated files with user+  edits, and publishes the installed cache only after the project succeeds.++  `seihou upgrade` is a lower-level cache-maintenance command. It refreshes+  the shared installed copy but does not reconcile templates or user edits in+  the current project. Use it when cache-only maintenance is intentional.+  See `seihou help update` and `seihou help migrations`.
help/migrations.md view
@@ -1,5 +1,27 @@ MIGRATIONS +Seihou has two migration systems. Deterministic module migrations use typed+filesystem operations and `seihou migrate`. Agent-guided blueprint migrations+use one library-upgrade prompt per version edge and `seihou agent migrate`.++BLUEPRINT MIGRATIONS++  A library blueprint declares entries with `from`, `to`, and a Markdown+  `prompt`. Consumers always supply explicit dotted numeric versions:++    seihou agent migrate my-library --from 1.0.0 --to 3.0.0++  The planner orders in-window entries by `from` and permits gaps. Each entry+  runs in its own provider session, then receives an exact-edge receipt before+  the next starts. A normal rerun resumes after receipts; --rerun repeats them.+  Parent --debug renders pending prompts in order without launching a provider+  or changing the manifest. Migration mode never applies blueprint baseModules.++  A receipt means the agent interaction completed successfully. It does not+  verify that Cabal, npm, Cargo, or another package manager reports the target.++DETERMINISTIC MODULE MIGRATIONS+ A migration is an author-declared sequence of file-system operations that moves a project's working tree from one module version to another. When a module is upgraded — say, from haskell-base 1.0.0 to 2.0.0 — the project@@ -13,9 +35,9 @@   Add a migration when a new version of your module changes the *layout*   of the files it generates: a directory rename, a file removal, a path   pattern shift. You do not need a migration for content-only changes;-  re-running `seihou run <module>` already updates file content. Use-  migrations specifically for things that `seihou run` cannot infer on-  its own.+  `seihou update <target>` already reconciles newly generated content with+  the project. Use migrations specifically for layout changes that template+  regeneration cannot infer on its own.  THE MIGRATION RECORD @@ -135,28 +157,41 @@   For a machine-readable form, pass `--json` (works alongside   `--dry-run`). -UPGRADE INTEGRATION+PROJECT UPDATE INTEGRATION +  Routine project updates use `seihou update`. It fetches candidate sources+  into a staging area, plans applicable migrations automatically, and then+  reconciles the newly generated content with user edits. The migration and+  template transitions therefore share one preview, confirmation, recovery,+  and manifest-publication boundary.++  Use `seihou migrate <module>` directly for focused recovery or when you+  deliberately need its lower-level controls, such as an intermediate+  `--to VERSION`. See `seihou help update` for the routine workflow.++CACHE UPGRADE INTEGRATION+   `seihou upgrade` updates the central installed copy under   ~/.config/seihou/installed/<name>/ but does *not* rewrite project-  trees by default. After an upgrade that brings new migrations,-  `seihou upgrade` prints a one-line advisory:+  trees by default. After an upgrade that leaves a recorded project behind,+  `seihou upgrade` points the user at `seihou update` so migrations and+  generated content advance together:      note: haskell-base has 1 migration(s) pending (1.0.0 → 2.0.0);-          run 'seihou migrate haskell-base'+          run 'seihou update' to reconcile the recorded project application -  Pass `--with-migrations` to skip the advisory and run migrations-  for each upgraded module against the current project in one shot.+  `--with-migrations` remains available for compatibility when only the+  lower-level migration should run after refreshing the cache.  STATUS INTEGRATION    `seihou status` shows a `Pending migration: <from> -> <to> (<N>-  step(s)). Run: seihou migrate <name>` sub-line under any applied+  step(s)). Run: seihou update <target>` sub-line under any applied   module whose installed copy has advanced past the manifest's   recorded version. `<N>` is the count of in-window declared   migrations that will run; it may be zero (the version range has no   applicable migrations and the run will only advance the manifest).-  The line is informational — use `seihou migrate <module>` to apply.+  Recommendations are deduplicated by recorded top-level application.  MANIFEST GUARANTEE @@ -171,6 +206,8 @@  SEE ALSO +  seihou update --help+  seihou help update   seihou migrate --help   seihou upgrade --help   docs/user/migrations.md
help/modules.md view
@@ -80,6 +80,7 @@   seihou validate-module ./my-module   Check a module is well-formed   seihou install <git-url>             Install modules, recipes, or blueprints from git   seihou run <module> --var k=v        Run a module to generate files+  seihou update [target]                Update a recorded application and preserve user edits   seihou remove <module>               Remove an applied module and its files   seihou schema-upgrade ./my-module    Upgrade module.dhall to current schema @@ -88,5 +89,8 @@   Modules carry a `version` field that follows dotted-version semantics   (1.0.0, 1.2.3, etc.). When an author bumps a module's version and   changes its file layout, they can ship migrations alongside the new-  version that move existing project files into the new shape. Run-  `seihou help migrations` for the full reference.+  version that move existing project files into the new shape. For a+  recorded application, `seihou update` fetches the newer source, applies+  its migrations, regenerates files, and preserves user edits in one+  operation. Run `seihou help update` for the project workflow or+  `seihou help migrations` for the authoring reference.
+ help/update.md view
@@ -0,0 +1,117 @@+UPDATE++`seihou update` reconciles recorded module and recipe applications with newer+source content while preserving project-local edits. It is the routine way to+advance an existing project. `seihou run` remains the initial-generation and+explicit-reconfiguration command; `seihou upgrade` only refreshes the shared+installed cache.++BASIC WORKFLOW++  Preview every recorded application:++    seihou update --dry-run++  Update one recorded module or recipe application:++    seihou update master-plan++  Apply every recorded application in manifest order:++    seihou update++  Seihou stages newer source repositories before changing the installed cache,+  reuses the saved inputs for each module instance, plans migrations, renders+  new generated content, reconciles files, and runs only new or changed commands.+  The installed cache and manifest are published only after the managed update+  succeeds.++TARGET SELECTION++  TARGET may name a recorded module or recipe, or a module contained in a+  recorded application. Repeat TARGET to select several applications. With no+  target, every recorded application is selected.++  A targeted update stops if an unselected application also owns a path the+  selected applications would change. Name every required owner or run the+  no-target form; Seihou will not guess how to reconstruct an omitted layer.++SAVED INPUTS++  An ordinary update reuses the exact accepted value recorded for each module+  instance. Override a value with a repeatable `--var KEY=VALUE`. A newly added+  required variable follows the normal resolution chain and may prompt in an+  interactive terminal.++  `--reconfigure` intentionally ignores saved values and resolves every input+  again. Use it to change configuration, not for routine source updates.++MIGRATIONS++  Applicable module migrations are always included. Declarative moves and+  deletes are staged so `--dry-run` can show the post-migration file plan.+  Migration shell commands are listed but cannot be simulated or rolled back+  outside Seihou's managed paths. There is no skip-migrations flag because new+  templates against an old project layout would be unsafe.++THREE-WAY FILE RECONCILIATION++  For each generated text file, Seihou compares:++    baseline    Content generated by the previous successful application+    current     Content now on disk, including user edits+    generated   Content produced from the candidate source++  If only one side changed, that change wins. Non-overlapping user and module+  changes merge automatically. Overlapping edits become a conflict with diff3+  markers labeled current, baseline, and generated. Interactive runs let the+  user choose generated content, current content, conflict markers, or abort.++  An obsolete generated file is deleted only when it is unchanged. An edited+  orphan can be retained, detached, or explicitly deleted. `--force` accepts+  permitted deterministic conflict choices but retains edited orphans; it does+  not silently delete user data. Binary content that changed on both sides+  remains a conflict.++COMMANDS++  By default, only new or changed generated commands run. `--run-all-commands`+  executes every command and `--no-commands` executes none; those flags are+  mutually exclusive. Successful command receipts are published only when the+  entire command phase succeeds.++PREVIEW, AUTOMATION, AND COMMITS++  `--dry-run` prints the complete plan without changing project files, cache,+  baselines, or manifest. `--json` emits one machine-readable JSON document and+  disables prompts. Supply required values and conflict choices in advance for+  non-interactive use.++  `--commit` commits only managed paths from a successful update.+  `--commit-message MSG` supplies the message and implies `--commit`. Neither+  commit option can be combined with `--dry-run`.++TRANSACTION SAFETY++  Before mutation, Seihou checks that the manifest, project files, and staged+  sources still match the accepted plan. Managed migrations, files, baseline+  blobs, installed-cache entries, and the manifest are protected by recovery+  journals. The manifest is the final publication marker.++  External effects from module or migration shell commands cannot be undone.+  A failure reports that limitation instead of claiming a full rollback.++LEGACY PROJECTS++  A manifest without recorded applications needs one explicit TARGET for its+  first update. That successful run seeds application identity, saved inputs,+  ownership, generated baselines, and command receipts. Ambiguous legacy values+  are reported rather than guessed.++SEE ALSO++  seihou update --help+  seihou help modules+  seihou help migrations+  seihou status --help+  docs/cli/update.md
seihou-cli.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-cli-version: 0.4.0.0+version: 0.5.0.0 synopsis: CLI for Seihou project scaffolding description:   Command-line interface for Seihou, a composable project scaffolding@@ -18,6 +18,7 @@ build-type: Simple extra-source-files:   data/assist-prompt.md+  data/blueprint-migration-prompt.md   data/blueprint-prompt.md   data/bootstrap-prompt.md   data/prompt-run-prompt.md@@ -32,6 +33,7 @@   help/modules.md   help/prompts.md   help/templating.md+  help/update.md   help/variables.md  source-repository head@@ -53,9 +55,15 @@   exposed-modules:     Seihou.CLI.AgentCompletion     Seihou.CLI.AgentConfig+    Seihou.CLI.AgentConfigShow     Seihou.CLI.AgentLaunch+    Seihou.CLI.AgentModels     Seihou.CLI.AppliedBlueprint+    Seihou.CLI.AppliedBlueprintMigration+    Seihou.CLI.BlueprintExecution+    Seihou.CLI.BlueprintMigration     Seihou.CLI.BrowseFormat+    Seihou.CLI.CommandExecution     Seihou.CLI.CommitMessage     Seihou.CLI.Completions.Bash     Seihou.CLI.Completions.Fish@@ -79,6 +87,14 @@     Seihou.CLI.Shared     Seihou.CLI.StatusRender     Seihou.CLI.Style+    Seihou.CLI.Update+    Seihou.CLI.Update.Interaction+    Seihou.CLI.Update.Migrations+    Seihou.CLI.Update.Recovery+    Seihou.CLI.Update.Render+    Seihou.CLI.Update.Selection+    Seihou.CLI.Update.Source+    Seihou.CLI.Update.Types     Seihou.CLI.VersionCompare     Seihou.Effect.Fzf     Seihou.Effect.FzfInterp@@ -90,9 +106,9 @@     aeson >=2.1 && <3,     aeson-pretty >=0.8 && <1,     ansi-terminal >=1.1 && <2,-    baikai ^>=0.3.0.0,-    baikai-claude ^>=0.3.0.0,-    baikai-openai ^>=0.3.0.0,+    baikai ^>=0.4.0.0,+    baikai-claude ^>=0.3.0.1,+    baikai-openai ^>=0.3.0.1,     base >=4.18 && <5,     bytestring >=0.11 && <1,     containers >=0.6 && <1,@@ -101,7 +117,7 @@     file-embed >=0.0.15 && <1,     filepath >=1.4 && <2,     process >=1.6 && <2,-    seihou-core ^>=0.4.0.0,+    seihou-core ^>=0.5.0.0,     temporary >=1.3 && <2,     text >=2.0 && <3,     time >=1.12 && <2,@@ -116,6 +132,7 @@     OverloadedLabels     OverloadedRecordDot     OverloadedStrings+    PackageImports     TypeFamilies    hs-source-dirs: src-exe@@ -132,6 +149,7 @@   other-modules:     Paths_seihou_cli     Seihou.CLI.AgentLaunchExec+    Seihou.CLI.AgentMigrate     Seihou.CLI.AgentRun     Seihou.CLI.Assist     Seihou.CLI.Bootstrap@@ -154,6 +172,7 @@     Seihou.CLI.SchemaUpgrade     Seihou.CLI.Setup     Seihou.CLI.Status+    Seihou.CLI.Update     Seihou.CLI.Upgrade     Seihou.CLI.Validate     Seihou.CLI.ValidateBlueprint@@ -165,10 +184,10 @@     aeson >=2.1 && <3,     aeson-pretty >=0.8 && <1,     ansi-terminal >=1.1 && <2,-    baikai ^>=0.3.0.0,-    baikai-claude ^>=0.3.0.0,-    baikai-kit ^>=0.1.0.1,-    baikai-openai ^>=0.3.0.0,+    baikai ^>=0.4.0.0,+    baikai-claude ^>=0.3.0.1,+    baikai-kit ^>=0.1.0.2,+    baikai-openai ^>=0.3.0.1,     base >=4.18 && <5,     bytestring >=0.11 && <1,     containers >=0.6 && <1,@@ -180,7 +199,7 @@     optparse-applicative >=0.18 && <1,     process >=1.6 && <2,     seihou-cli-internal,-    seihou-core ^>=0.4.0.0,+    seihou-core ^>=0.5.0.0,     temporary >=1.3 && <2,     text >=2.0 && <3,     time >=1.12 && <2,@@ -202,10 +221,16 @@    other-modules:     Seihou.CLI.AgentCompletionSpec+    Seihou.CLI.AgentConfigShowSpec     Seihou.CLI.AgentConfigSpec     Seihou.CLI.AgentLaunchSpec+    Seihou.CLI.AgentMigrateE2ESpec+    Seihou.CLI.AgentModelsSpec+    Seihou.CLI.AppliedBlueprintMigrationSpec     Seihou.CLI.AppliedBlueprintSpec+    Seihou.CLI.BlueprintMigrationSpec     Seihou.CLI.BrowseFormatSpec+    Seihou.CLI.CommandExecutionSpec     Seihou.CLI.CommitMessageSpec     Seihou.CLI.DiffSpec     Seihou.CLI.ExtensionSpec@@ -222,12 +247,20 @@     Seihou.CLI.RunBlueprintRefusalSpec     Seihou.CLI.SavePromptedSpec     Seihou.CLI.StatusSpec+    Seihou.CLI.UpdateE2ESpec+    Seihou.CLI.UpdateFixture+    Seihou.CLI.UpdateInteractionSpec+    Seihou.CLI.UpdateRenderSpec+    Seihou.CLI.UpdateSpec     Seihou.CLI.UpgradeSpec     Seihou.FzfSpec +  build-tool-depends:+    seihou-cli:seihou+   build-depends:     aeson >=2.1 && <3,-    baikai ^>=0.3.0.0,+    baikai ^>=0.4.0.0,     base >=4.18 && <5,     bytestring >=0.11 && <1,     containers >=0.6 && <1,@@ -237,7 +270,7 @@     hspec >=2.11 && <3,     process >=1.6 && <2,     seihou-cli-internal,-    seihou-core ^>=0.4.0.0,+    seihou-core ^>=0.5.0.0,     tasty >=1.4 && <2,     tasty-hspec >=1.2 && <2,     temporary >=1.3 && <2,
src-exe/Main.hs view
@@ -2,12 +2,16 @@  import Control.Applicative ((<|>)) import Data.List (isPrefixOf)+import Data.Maybe (isJust) import Data.String (fromString) import Data.Text (Text) import Data.Text.IO qualified as TIO import Options.Applicative (customExecParser, prefs, showHelpOnEmpty) import Seihou.CLI.AgentCompletion qualified as AgentCompletion-import Seihou.CLI.AgentConfig (loadAgentModelConfig)+import Seihou.CLI.AgentConfig (AgentCommandName (..), loadAgentModelConfigFor)+import Seihou.CLI.AgentConfigShow (handleAgentConfigShow)+import Seihou.CLI.AgentMigrate (handleAgentMigrate)+import Seihou.CLI.AgentModels qualified as AgentModels import Seihou.CLI.AgentRun (handleAgentRun) import Seihou.CLI.Assist (handleAssist) import Seihou.CLI.Bootstrap (handleBootstrap)@@ -36,6 +40,7 @@ import Seihou.CLI.SchemaUpgrade (handleSchemaUpgrade) import Seihou.CLI.Setup (handleSetup) import Seihou.CLI.Status (handleStatus)+import Seihou.CLI.Update (handleUpdate) import Seihou.CLI.Upgrade (handleUpgrade) import Seihou.CLI.Validate (handleValidateModule) import Seihou.CLI.ValidateBlueprint (handleValidateBlueprint)@@ -75,6 +80,8 @@       handleInit     Run runOpts ->       handleRun runOpts+    Update updateOpts ->+      handleUpdate updateOpts     Remove removeOpts ->       handleRemove removeOpts     Vars varsOpts ->@@ -127,21 +134,42 @@     Agent agentOpts -> do       case agentOpts.agentCommand of         AgentAssist assistOpts -> do-          modelConfig <- resolveAgentModelConfig agentOpts.agentProvider agentOpts.agentModel assistOpts.assistProvider assistOpts.assistModel+          modelConfig <- resolveAgentModelConfigFor AgentCmdAssist agentOpts.agentProvider agentOpts.agentModel agentOpts.agentEffort assistOpts.assistProvider assistOpts.assistModel assistOpts.assistEffort           handleAssist agentOpts.agentDebug modelConfig assistOpts         AgentBootstrap bootstrapOpts -> do-          modelConfig <- resolveAgentModelConfig agentOpts.agentProvider agentOpts.agentModel bootstrapOpts.bootstrapProvider bootstrapOpts.bootstrapModel+          modelConfig <- resolveAgentModelConfigFor AgentCmdBootstrap agentOpts.agentProvider agentOpts.agentModel agentOpts.agentEffort bootstrapOpts.bootstrapProvider bootstrapOpts.bootstrapModel bootstrapOpts.bootstrapEffort           handleBootstrap agentOpts.agentDebug modelConfig bootstrapOpts         AgentSetup setupOpts -> do-          modelConfig <- resolveAgentModelConfig agentOpts.agentProvider agentOpts.agentModel setupOpts.setupProvider setupOpts.setupModel+          modelConfig <- resolveAgentModelConfigFor AgentCmdSetup agentOpts.agentProvider agentOpts.agentModel agentOpts.agentEffort setupOpts.setupProvider setupOpts.setupModel setupOpts.setupEffort           handleSetup agentOpts.agentDebug modelConfig setupOpts         AgentRun blueprintRunOpts -> do-          modelConfig <- resolveAgentModelConfig agentOpts.agentProvider agentOpts.agentModel blueprintRunOpts.runBlueprintProvider blueprintRunOpts.runBlueprintModel+          modelConfig <- resolveAgentModelConfigFor AgentCmdRun agentOpts.agentProvider agentOpts.agentModel agentOpts.agentEffort blueprintRunOpts.runBlueprintProvider blueprintRunOpts.runBlueprintModel blueprintRunOpts.runBlueprintEffort           handleAgentRun agentOpts.agentDebug modelConfig blueprintRunOpts+        AgentMigrate migrationOpts -> do+          modelConfig <- resolveAgentModelConfigFor AgentCmdMigrate agentOpts.agentProvider agentOpts.agentModel agentOpts.agentEffort migrationOpts.migrateBlueprintProvider migrationOpts.migrateBlueprintModel migrationOpts.migrateBlueprintEffort+          handleAgentMigrate agentOpts.agentDebug modelConfig migrationOpts+        AgentModels modelsOpts ->+          case agentOpts.agentModel of+            Just _ -> do+              TIO.putStrLn "Error: --model does not apply to 'seihou agent models'; omit it to list known choices."+              exitFailure+            Nothing ->+              case modelsOpts.modelsProvider <|> agentOpts.agentProvider of+                Nothing ->+                  TIO.putStr (AgentModels.formatAgentModels Nothing AgentModels.availableAgentModels)+                Just providerText ->+                  case AgentCompletion.providerFromText providerText of+                    Left err -> do+                      TIO.putStrLn $ "Error: " <> err+                      exitFailure+                    Right provider ->+                      TIO.putStr (AgentModels.formatAgentModels (Just provider) AgentModels.availableAgentModels)+        AgentConfigShow ->+          handleAgentConfigShow     Prompt promptCmd -> do       case promptCmd of         PromptRun promptRunOpts -> do-          modelConfig <- resolveAgentModelConfig Nothing Nothing promptRunOpts.runPromptProvider promptRunOpts.runPromptModel+          modelConfig <- resolveAgentModelConfigFor AgentCmdPromptRun Nothing Nothing Nothing promptRunOpts.runPromptProvider promptRunOpts.runPromptModel promptRunOpts.runPromptEffort           handlePromptRun modelConfig promptRunOpts     Extension extensionCmd -> do       case extensionCmd of@@ -152,9 +180,27 @@     Completions completionsCmd ->       handleCompletionsCommand completionsCmd -resolveAgentModelConfig :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> IO AgentCompletion.AgentModelConfig-resolveAgentModelConfig parentProvider parentModel commandProvider commandModel = do-  configResult <- loadAgentModelConfig (commandProvider <|> parentProvider) (commandModel <|> parentModel)+-- | Resolve the effective provider/model/effort for one agent command. The+-- subcommand flag wins over the parent @seihou agent@ flag; that combined flag+-- then feeds the per-command config resolution, which also consults the+-- command's own @agent.<command>.*@ keys before the shared @agent.*@ defaults.+resolveAgentModelConfigFor ::+  AgentCommandName ->+  -- | parent @seihou agent@ provider, model, effort+  Maybe Text ->+  Maybe Text ->+  Maybe Text ->+  -- | subcommand provider, model, effort+  Maybe Text ->+  Maybe Text ->+  Maybe Text ->+  IO AgentCompletion.AgentModelConfig+resolveAgentModelConfigFor cmd parentProvider parentModel parentEffort commandProvider commandModel commandEffort = do+  let provider = commandProvider <|> parentProvider+      model = commandModel <|> parentModel+      effort = commandEffort <|> parentEffort+  configResult <-+    loadAgentModelConfigFor cmd provider model effort (isJust commandProvider) (isJust commandModel) (isJust commandEffort)   case configResult of     Left err -> do       TIO.putStrLn $ "Error: " <> err
src-exe/Seihou/CLI/AgentLaunchExec.hs view
@@ -10,6 +10,7 @@     CodexSandboxMode (CodexWorkspaceWrite),     InteractiveLaunchResult (..),     InteractiveSafety (ClaudeAllowedTools, CodexSandbox),+    effort,     extraDirs,     interactiveLaunchRequest,     modelId,@@ -26,6 +27,7 @@   ( defaultCodexInteractiveConfig,     launchCodexInteractive,   )+import Baikai.ThinkingLevel (ThinkingLevel) import Data.Text qualified as T import Data.Text.IO qualified as TIO import Seihou.CLI.AgentCompletion (AgentModelConfig (..), AgentProvider (..))@@ -50,16 +52,16 @@   | otherwise =       case modelConfig.agentProvider of         AgentProviderClaudeCli ->-          launchClaude addDirs tools modelConfig.agentModel systemPrompt initialPrompt+          launchClaude addDirs tools modelConfig.agentModel modelConfig.agentEffort systemPrompt initialPrompt         AgentProviderCodexCli ->-          launchCodex addDirs modelConfig.agentModel systemPrompt initialPrompt+          launchCodex addDirs modelConfig.agentModel modelConfig.agentEffort systemPrompt initialPrompt         AgentProviderAnthropic ->           unsupportedInteractiveProvider "anthropic"         AgentProviderOpenAI ->           unsupportedInteractiveProvider "openai" -launchClaude :: [FilePath] -> [String] -> Maybe Text -> Text -> Maybe Text -> IO ExitCode-launchClaude addDirs tools model systemPrompt initialPrompt = do+launchClaude :: [FilePath] -> [String] -> Maybe Text -> Maybe ThinkingLevel -> Text -> Maybe Text -> IO ExitCode+launchClaude addDirs tools model effortLevel systemPrompt initialPrompt = do   claudePath <- findExecutable "claude"   case claudePath of     Nothing -> do@@ -74,14 +76,15 @@           (interactiveLaunchRequest (promptOrEmpty initialPrompt))             { systemPrompt = Just systemPrompt,               modelId = model,+              effort = effortLevel,               workingDir = Just cwd,               extraDirs = addDirs,               safety = ClaudeAllowedTools (map T.pack tools)             }       pure exitCode -launchCodex :: [FilePath] -> Maybe Text -> Text -> Maybe Text -> IO ExitCode-launchCodex addDirs model systemPrompt initialPrompt = do+launchCodex :: [FilePath] -> Maybe Text -> Maybe ThinkingLevel -> Text -> Maybe Text -> IO ExitCode+launchCodex addDirs model effortLevel systemPrompt initialPrompt = do   codexPath <- findExecutable "codex"   case codexPath of     Nothing -> do@@ -96,6 +99,7 @@           (interactiveLaunchRequest (promptOrEmpty initialPrompt))             { systemPrompt = Just systemPrompt,               modelId = model,+              effort = effortLevel,               workingDir = Just cwd,               extraDirs = addDirs,               safety = CodexSandbox CodexWorkspaceWrite CodexApprovalOnRequest
+ src-exe/Seihou/CLI/AgentMigrate.hs view
@@ -0,0 +1,337 @@+{-# LANGUAGE TemplateHaskell #-}++module Seihou.CLI.AgentMigrate+  ( handleAgentMigrate,+  )+where++import Data.FileEmbed (embedFile)+import Data.Maybe (maybeToList)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Text.IO qualified as TIO+import Data.Time.Clock (getCurrentTime)+import Seihou.CLI.AgentCompletion+  ( AgentModelConfig (..),+    AgentProvider (..),+    buildAgentCompletionRequest,+    runAgentCompletion,+  )+import Seihou.CLI.AgentLaunch (gatherAgentContext)+import Seihou.CLI.AgentLaunchExec (launchConfiguredAgentAddingDirs)+import Seihou.CLI.AppliedBlueprintMigration (recordAppliedBlueprintMigration)+import Seihou.CLI.BlueprintExecution+  ( BlueprintExecutionRequest (..),+    PreparedBlueprintExecution (..),+    prepareBlueprintExecution,+  )+import Seihou.CLI.BlueprintMigration+  ( BlueprintMigrationLaunchFailure (..),+    BlueprintMigrationRunResult (..),+    formatBlueprintMigrationDebugOutput,+    pendingBlueprintMigrations,+    renderBlueprintMigrationSystemPrompt,+    runBlueprintMigrationsWith,+  )+import Seihou.CLI.Commands (BlueprintMigrationOpts (..))+import Seihou.CLI.Shared (formatVarError, logIO)+import Seihou.Core.Blueprint (validateBlueprint)+import Seihou.Core.Migration+  ( BlueprintMigration (..),+    BlueprintMigrationPlan (..),+    MigrationPlanError (..),+    planBlueprintMigrationChain,+  )+import Seihou.Core.Module (defaultSearchPaths, discoverRunnable)+import Seihou.Core.Types+import Seihou.Core.Version (Version, parseVersion, renderVersion)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.Logger (logError)+import Seihou.Effect.ManifestStore (readManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Prelude+import System.Exit (ExitCode (..), exitFailure, exitWith)++migrationPromptTemplate :: Text+migrationPromptTemplate = TE.decodeUtf8 $(embedFile "data/blueprint-migration-prompt.md")++handleAgentMigrate :: Bool -> AgentModelConfig -> BlueprintMigrationOpts -> IO ()+handleAgentMigrate debug modelConfig opts = do+  let level = if opts.migrateBlueprintVerbose then LogVerbose else LogNormal+      manifestPath = ".seihou" </> "manifest.json"++  (blueprint, blueprintDir) <- discoverMigrationBlueprint level opts.migrateBlueprintName+  validationResult <- validateBlueprint blueprintDir blueprint+  case validationResult of+    Left err -> exitErr level (renderModuleLoadError err)+    Right _ -> pure ()++  current <- parseRequestedVersion level "--from" opts.migrateBlueprintFrom+  target <- parseRequestedVersion level "--to" opts.migrateBlueprintTo+  planned <-+    case planBlueprintMigrationChain blueprint.name.unModuleName blueprint.migrations current target of+      Left err -> exitErr level (renderPlanError err)+      Right Nothing -> do+        TIO.putStrLn "No blueprint migration needed: --from and --to resolve to the same version."+        pure Nothing+      Right (Just migrationPlan) -> pure (Just migrationPlan)++  case planned of+    Nothing -> pure ()+    Just migrationPlan -> do+      receipts <- readMigrationReceipts level manifestPath+      let pending =+            pendingBlueprintMigrations+              opts.migrateBlueprintRerun+              blueprint.name+              receipts+              migrationPlan+      if null pending+        then reportNoPending migrationPlan+        else do+          prepared <- prepare level modelConfig opts blueprint blueprintDir+          context <- gatherAgentContext+          let renderStep position total migration =+                renderBlueprintMigrationSystemPrompt+                  migrationPromptTemplate+                  context+                  prepared+                  position+                  total+                  migration+              renderDebugStep position total migration =+                renderStep position total migration+                  <> maybe+                    ""+                    ("\n\n===== Initial user instruction =====\n" <>)+                    opts.migrateBlueprintPrompt++          if debug+            then+              TIO.putStrLn $+                "Blueprint migrations for "+                  <> blueprint.name.unModuleName+                  <> ": "+                  <> renderVersion migrationPlan.blueprintPlanFrom+                  <> " -> "+                  <> renderVersion migrationPlan.blueprintPlanTo+                  <> "\n"+                  <> formatBlueprintMigrationDebugOutput renderDebugStep pending+            else do+              result <-+                runBlueprintMigrationsWith+                  (launchMigration modelConfig opts prepared renderStep)+                  (recordMigration manifestPath blueprint)+                  pending+              handleRunResult level blueprint.name result++discoverMigrationBlueprint :: LogLevel -> ModuleName -> IO (Blueprint, FilePath)+discoverMigrationBlueprint level requestedName = do+  searchPaths <- defaultSearchPaths+  runnableResult <- discoverRunnable searchPaths requestedName+  case runnableResult of+    Right (RunnableBlueprint blueprint dir) -> pure (blueprint, dir)+    Right (RunnableModule _ _) ->+      exitErr level $ "'" <> requestedName.unModuleName <> "' is a module, not a blueprint."+    Right (RunnableRecipe _ _) ->+      exitErr level $ "'" <> requestedName.unModuleName <> "' is a recipe, not a blueprint."+    Right (RunnableAgentPrompt _ _) ->+      exitErr level $ "'" <> requestedName.unModuleName <> "' is a prompt, not a blueprint."+    Left err -> exitErr level (renderModuleLoadError err)++parseRequestedVersion :: LogLevel -> Text -> Text -> IO Version+parseRequestedVersion level flag raw =+  case parseVersion raw of+    Just version -> pure version+    Nothing -> exitErr level (flag <> " value '" <> raw <> "' is not a valid dotted numeric version.")++readMigrationReceipts :: LogLevel -> FilePath -> IO [AppliedBlueprintMigration]+readMigrationReceipts level manifestPath = do+  result <- runEff $ runFilesystem $ runManifestStore manifestPath readManifest+  case result of+    Left err -> exitErr level ("Error reading migration receipts: " <> err)+    Right Nothing -> pure []+    Right (Just manifest) -> pure manifest.blueprintMigrations++prepare ::+  LogLevel ->+  AgentModelConfig ->+  BlueprintMigrationOpts ->+  Blueprint ->+  FilePath ->+  IO PreparedBlueprintExecution+prepare level modelConfig opts blueprint blueprintDir = do+  let providerCanMountFiles =+        modelConfig.agentProvider == AgentProviderClaudeCli+          || modelConfig.agentProvider == AgentProviderCodexCli+  result <-+    prepareBlueprintExecution+      BlueprintExecutionRequest+        { executionBlueprint = blueprint,+          executionBlueprintDir = blueprintDir,+          executionVariableOverrides = opts.migrateBlueprintVars,+          executionNamespaceOverride = opts.migrateBlueprintNamespace,+          executionContextOverride = opts.migrateBlueprintContext,+          executionCanMountFiles = providerCanMountFiles,+          executionLogLevel = level+        }+  case result of+    Left errs -> do+      logIO level $ logError "Error resolving blueprint migration variables:"+      mapM_ (logIO level . logError . ("  " <>) . formatVarError) errs+      exitFailure+    Right prepared -> pure prepared++launchMigration ::+  AgentModelConfig ->+  BlueprintMigrationOpts ->+  PreparedBlueprintExecution ->+  (Int -> Int -> BlueprintMigration -> Text) ->+  Int ->+  Int ->+  BlueprintMigration ->+  IO (Either BlueprintMigrationLaunchFailure ())+launchMigration modelConfig opts prepared renderStep position total migration = do+  TIO.putStrLn $+    "Running blueprint migration "+      <> T.pack (show position)+      <> "/"+      <> T.pack (show total)+      <> ": "+      <> migration.from+      <> " -> "+      <> migration.to+  let systemPrompt = renderStep position total migration+  case modelConfig.agentProvider of+    AgentProviderClaudeCli -> launchInteractive systemPrompt+    AgentProviderCodexCli -> launchInteractive systemPrompt+    AgentProviderAnthropic -> launchCompletion systemPrompt+    AgentProviderOpenAI -> launchCompletion systemPrompt+  where+    launchInteractive systemPrompt = do+      exitCode <-+        launchConfiguredAgentAddingDirs+          (maybeToList prepared.preparedMountedFilesDir)+          modelConfig+          prepared.preparedAllowedTools+          False+          systemPrompt+          opts.migrateBlueprintPrompt+      pure $ case exitCode of+        ExitSuccess -> Right ()+        failure -> Left (BlueprintMigrationProcessFailure failure)++    launchCompletion systemPrompt = do+      result <-+        runAgentCompletion+          (buildAgentCompletionRequest modelConfig systemPrompt opts.migrateBlueprintPrompt)+      case result of+        Left err -> pure (Left (BlueprintMigrationProviderFailure err))+        Right assistantText -> do+          TIO.putStrLn assistantText+          pure (Right ())++recordMigration ::+  FilePath ->+  Blueprint ->+  BlueprintMigration ->+  IO (Either Text ())+recordMigration manifestPath blueprint migration = do+  now <- getCurrentTime+  recordAppliedBlueprintMigration+    manifestPath+    AppliedBlueprintMigration+      { name = blueprint.name,+        blueprintVersion = blueprint.version,+        fromVersion = migration.from,+        toVersion = migration.to,+        appliedAt = now,+        agentSessionId = Nothing+      }++handleRunResult :: LogLevel -> ModuleName -> BlueprintMigrationRunResult -> IO ()+handleRunResult level blueprintName = \case+  BlueprintMigrationNoWork ->+    TIO.putStrLn "No pending blueprint migrations."+  BlueprintMigrationComplete completed ->+    TIO.putStrLn $+      "Completed "+        <> T.pack (show (length completed))+        <> " blueprint migration(s) for '"+        <> blueprintName.unModuleName+        <> "'."+  BlueprintMigrationLaunchFailed migration failure -> do+    let prefix =+          "Blueprint migration "+            <> migration.from+            <> " -> "+            <> migration.to+            <> " failed; completed earlier edges remain recorded. "+        retry = "Fix the provider error, then rerun the same command to resume."+    case failure of+      BlueprintMigrationProcessFailure exitCode -> do+        logIO level $ logError $ prefix <> "Provider exited with " <> T.pack (show exitCode) <> ". " <> retry+        exitWith exitCode+      BlueprintMigrationProviderFailure err -> do+        logIO level $ logError $ prefix <> err <> " " <> retry+        exitFailure+  BlueprintMigrationRecordFailed migration err -> do+    logIO level $+      logError $+        "Agent completed blueprint migration "+          <> migration.from+          <> " -> "+          <> migration.to+          <> ", but its receipt could not be recorded: "+          <> err+          <> ". The next edge was not started; repair manifest access, then rerun the same command."+    exitFailure++reportNoPending :: BlueprintMigrationPlan -> IO ()+reportNoPending migrationPlan+  | null migrationPlan.blueprintPlanSteps =+      TIO.putStrLn "No blueprint migrations are declared inside the requested version window."+  | otherwise =+      TIO.putStrLn "All blueprint migrations in the requested version window already have receipts."++renderPlanError :: MigrationPlanError -> Text+renderPlanError (MigrationVersionUnparseable raw) =+  "the blueprint declares an unparseable migration version: '" <> raw <> "'."+renderPlanError (MigrationDowngradeNotSupported current target) =+  "blueprint migration downgrades are not supported: --from "+    <> renderVersion current+    <> ", --to "+    <> renderVersion target+    <> "."+renderPlanError (MigrationDuplicateEdge fromVersion _) =+  "the blueprint declares more than one migration starting at "+    <> renderVersion fromVersion+    <> "; the author must merge or remove the duplicate."++renderModuleLoadError :: ModuleLoadError -> Text+renderModuleLoadError = \case+  ModuleNotFound name searched ->+    "Blueprint '"+      <> name.unModuleName+      <> "' not found. Searched in:\n"+      <> T.intercalate "\n" (map (("  " <>) . T.pack) searched)+  DhallEvalError name msg ->+    "Failed to evaluate '" <> name.unModuleName <> "': " <> msg+  DhallDecodeError name msg ->+    "Failed to decode '" <> name.unModuleName <> "': " <> msg+  ValidationError name msgs ->+    "Validation failed for '"+      <> name.unModuleName+      <> "':\n"+      <> T.intercalate "\n" (map ("  " <>) msgs)+  CircularDependency names ->+    "Circular dependency detected: " <> T.intercalate " -> " (map (.unModuleName) names)+  MissingSourceFile name path ->+    "Missing source file in '" <> name.unModuleName <> "': " <> T.pack path+  RegistryEvalError path msg ->+    "Failed to evaluate registry at '" <> path <> "': " <> msg++exitErr :: LogLevel -> Text -> IO a+exitErr level msg = do+  logIO level (logError msg)+  exitFailure
src-exe/Seihou/CLI/AgentRun.hs view
@@ -12,6 +12,7 @@   ) where +import Control.Exception (IOException, displayException, try) import Control.Monad (when) import Data.FileEmbed (embedFile) import Data.Map.Strict qualified as Map@@ -36,15 +37,18 @@     formatLocalModules,     formatManifestState,     formatModuleDhallState,-    formatReferenceFiles,-    formatReferenceFilesDir,     formatSeihouProjectState,     gatherAgentContext,-    resolveBlueprintTools,     substitute,   ) import Seihou.CLI.AgentLaunchExec (launchConfiguredAgentAddingDirs) import Seihou.CLI.AppliedBlueprint (recordAppliedBlueprint)+import Seihou.CLI.BlueprintExecution+  ( BlueprintExecutionRequest (..),+    PreparedBlueprintExecution (..),+    prepareBlueprintExecution,+    varValueToText,+  ) import Seihou.CLI.Commands (BlueprintRunOpts (..)) import Seihou.CLI.Shared   ( deriveNamespace,@@ -53,12 +57,14 @@     toVarNameMap,     unwrapConfig,   )-import Seihou.Composition.Instance (ModuleInstance (..), primaryInstance, qualifiedName)+import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName) import Seihou.Composition.Plan (compileComposedPlan) import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts) import Seihou.Core.Context (resolveContext) import Seihou.Core.Module (defaultSearchPaths, discoverRunnable) import Seihou.Core.Types+import Seihou.Effect.BaselineStore (pruneBaselines)+import Seihou.Effect.BaselineStoreInterp (runBaselineStore) import Seihou.Effect.ConfigReader   ( readContextConfig,     readGlobalConfig,@@ -69,15 +75,15 @@ import Seihou.Effect.ConsoleInterp (runConsole) import Seihou.Effect.Filesystem (createDirectoryIfMissing) import Seihou.Effect.FilesystemInterp (runFilesystem)-import Seihou.Effect.Logger (logError, logInfo)+import Seihou.Effect.Logger (logError, logInfo, logWarn) import Seihou.Effect.ManifestStore (readManifest, writeManifest) import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Engine.Baseline (manifestBaselineRefs, recordGeneratedBaselines) import Seihou.Engine.Conflict (resolveConflicts) import Seihou.Engine.Diff (computeDiff) import Seihou.Engine.Execute (executePlan) import Seihou.Manifest.Types (currentManifestVersion, emptyManifest) import Seihou.Prelude-import System.Directory (doesDirectoryExist, makeAbsolute) import System.Environment (getEnvironment) import System.Exit (ExitCode (..), exitFailure, exitWith) import System.FilePath (takeDirectory, (</>))@@ -112,66 +118,29 @@           <> "'?"     Left err -> exitErr level (renderModuleLoadError err) -  let filesDir = blueprintDir </> "files"-      providerCanMountFiles =+  let providerCanMountFiles =         modelConfig.agentProvider == AgentProviderClaudeCli           || modelConfig.agentProvider == AgentProviderCodexCli-  filesExist <- doesDirectoryExist filesDir-  mFilesDir <--    if filesExist && providerCanMountFiles-      then Just <$> makeAbsolute filesDir-      else pure Nothing--  -- (b) Resolve blueprint variables. Wrap the blueprint's vars/prompts-  -- in a placeholder Module so 'resolveWithPrompts' can run the-  -- standard precedence chain (CLI > env > local > namespace > context-  -- > global > defaults > interactive prompts).-  let placeholderModule =-        Module-          { name = bp.name,-            version = bp.version,-            description = bp.description,-            vars = bp.vars,-            exports = [],-            prompts = bp.prompts,-            steps = [],-            commands = [],-            dependencies = [],-            removal = Nothing,-            migrations = []-          }-      placeholderInst = primaryInstance bp.name-      placeholderTriple = (placeholderInst, placeholderModule, blueprintDir)--  envPairs <- getEnvironment-  let cliOverrides = Map.fromList [(VarName k, v) | (k, v) <- opts.runBlueprintVars]-      envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]-      namespace = fromMaybe (deriveNamespace bp.name) opts.runBlueprintNamespace-  context <- resolveContext opts.runBlueprintContext envVars-  let contextName = fromMaybe "" context--  resolveResult <- runEff $ runConfigReader $ runConsole $ do-    localCfg <- readLocalConfig >>= unwrapConfig level-    nsCfg <- readNamespaceConfig namespace >>= unwrapConfig level-    ctxCfg <- readContextConfig contextName >>= unwrapConfig level-    gCfg <- readGlobalConfig >>= unwrapConfig level-    resolveWithPrompts-      [placeholderTriple]-      cliOverrides-      envVars-      namespace-      contextName-      (toVarNameMap localCfg)-      (toVarNameMap nsCfg)-      (toVarNameMap ctxCfg)-      (toVarNameMap gCfg)--  resolved <- case resolveResult of+  -- (b) Resolve variables and prepare the shared prompt/reference/tool state.+  preparedResult <-+    prepareBlueprintExecution+      BlueprintExecutionRequest+        { executionBlueprint = bp,+          executionBlueprintDir = blueprintDir,+          executionVariableOverrides = opts.runBlueprintVars,+          executionNamespaceOverride = opts.runBlueprintNamespace,+          executionContextOverride = opts.runBlueprintContext,+          executionCanMountFiles = providerCanMountFiles,+          executionLogLevel = level+        }+  prepared <- case preparedResult of     Left errs -> do       logIO level $ logError "Error resolving blueprint variables:"       mapM_ (logIO level . logError . ("  " <>) . formatVarError) errs       exitFailure-    Right r -> pure (Map.findWithDefault Map.empty placeholderInst r)+    Right result -> pure result+  let resolved = prepared.preparedResolvedVariables+      cliOverrides = Map.fromList [(VarName k, v) | (k, v) <- opts.runBlueprintVars]    -- (c) Baseline.   baseline <-@@ -182,20 +151,17 @@           then pure BaselineEmpty           else applyBaseline level opts bp.baseModules cliOverrides resolved -  -- (d) Render the user prompt: substitute resolved vars into bp.prompt.-  let renderedUser = renderUserPrompt resolved bp.prompt--  -- (e) Render the system prompt around the user body.+  -- (d) Render the system prompt around the prepared shared body.   ctx <- gatherAgentContext-  let systemPrompt = renderSystemPrompt ctx bp baseline mFilesDir renderedUser+  let systemPrompt = renderSystemPrompt ctx prepared baseline    -- (f) Launch.   launchSucceeded <-     runRenderedAgentPrompt       debug       modelConfig-      (resolveBlueprintTools bp.allowedTools)-      mFilesDir+      prepared.preparedAllowedTools+      prepared.preparedMountedFilesDir       systemPrompt       opts.runBlueprintPrompt @@ -347,6 +313,7 @@   -- write the manifest. Mirrors Seihou.CLI.Run.handleRun.   now <- getCurrentTime   let manifestPath = ".seihou" </> "manifest.json"+      baselineDir = ".seihou" </> "baselines"       planned =         [(dest, content, primary, Nothing) | WriteFileOp dest content _ <- ops]           ++ [(dest, content, mName, Just pOp) | PatchFileOp dest content pOp _ mName <- ops]@@ -384,7 +351,9 @@                         { hash = c.diskHash,                           moduleName = c.moduleName,                           strategy = Template,-                          generatedAt = now+                          generatedAt = now,+                          baseline = Nothing,+                          applicationIds = mempty                         }                 )               | (c, KeepCurrent) <- conflictResolved@@ -393,26 +362,57 @@           excludePaths = Set.fromList (Map.keys keepRecords ++ skipPaths)           opsForExec = filter (not . opTargetsPath excludePaths) ops -      runEff $ runFilesystem $ runManifestStore manifestPath $ do-        recs <- executePlan "" opsForExec ownerMap primary now+      generationAttempt <-+        try @IOException $+          runEff $+            runFilesystem $+              runBaselineStore baselineDir $+                runManifestStore manifestPath $ do+                  recs <- executePlan "" opsForExec ownerMap primary now+                  baselineResult <- recordGeneratedBaselines "" recs+                  case baselineResult of+                    Left err -> pure (Left err)+                    Right baselineRecords -> do+                      let orphanedPaths = map (.path) diff.orphaned+                          cleanedFiles = foldr Map.delete manifest.files orphanedPaths+                          allModuleEntries = updateAllModules manifest.modules modulesInOrder now+                          allResolvedVals =+                            Map.unions [Map.map (.value) vs | vs <- Map.elems baseResolved]+                          newManifest =+                            Manifest+                              { version = currentManifestVersion,+                                genAt = now,+                                modules = allModuleEntries,+                                vars = Map.union (Map.map varValueToText allResolvedVals) manifest.vars,+                                files = Map.unions [baselineRecords, keepRecords, cleanedFiles],+                                applications = manifest.applications,+                                recipe = manifest.recipe,+                                blueprint = manifest.blueprint,+                                blueprintMigrations = manifest.blueprintMigrations+                              }+                      writeManifest newManifest+                      pure (Right newManifest) -        let orphanedPaths = map (.path) diff.orphaned-            cleanedFiles = foldr Map.delete manifest.files orphanedPaths-            allModuleEntries = updateAllModules manifest.modules modulesInOrder now-            allResolvedVals =-              Map.unions [Map.map (.value) vs | vs <- Map.elems baseResolved]-            newManifest =-              Manifest-                { version = currentManifestVersion,-                  genAt = now,-                  modules = allModuleEntries,-                  vars = Map.union (Map.map varValueToText allResolvedVals) manifest.vars,-                  files = Map.unions [recs, keepRecords, cleanedFiles],-                  recipe = manifest.recipe,-                  blueprint = manifest.blueprint-                }-        writeManifest newManifest+      newManifest <- case generationAttempt of+        Left err -> do+          logIO level $ logError $ "Error applying baseline files or storing generated baselines: " <> T.pack (displayException err)+          exitFailure+        Right (Left err) -> do+          logIO level $ logError $ "Error storing generated baselines: " <> T.pack (show err)+          exitFailure+        Right (Right saved) -> pure saved +      pruneAttempt <-+        try @IOException $+          runEff $+            runFilesystem $+              runBaselineStore baselineDir $+                pruneBaselines (manifestBaselineRefs newManifest)+      case pruneAttempt of+        Left err ->+          logIO level $ logWarn $ "Warning: could not prune generated baselines: " <> T.pack (displayException err)+        Right _ -> pure ()+       let nNew = length diff.new           nMod = length diff.modified           nUnch = length diff.unchanged@@ -431,40 +431,25 @@  -- | Stitch the system-prompt template together. Each block in -- @blueprint-prompt.md@ has a @{{key}}@ placeholder filled here.-renderSystemPrompt :: AgentContext -> Blueprint -> BaselineStatus -> Maybe FilePath -> Text -> Text-renderSystemPrompt ctx bp baseline mFilesDir userPrompt =-  substitute-    [ ("cwd", ctx.cwd),-      ("seihou_project_state", formatSeihouProjectState ctx),-      ("manifest_state", formatManifestState ctx),-      ("module_dhall_state", formatModuleDhallState ctx),-      ("local_modules", formatLocalModules ctx),-      ("available_modules", formatAvailableModules ctx),-      ("blueprint_name", bp.name.unModuleName),-      ("blueprint_version", fromMaybe "(unspecified)" bp.version),-      ("blueprint_description", fromMaybe "(no description)" bp.description),-      ("baseline_status", formatBaselineStatus baseline),-      ("reference_files", formatReferenceFiles bp.files),-      ("reference_files_dir", formatReferenceFilesDir mFilesDir),-      ("user_prompt", userPrompt)-    ]-    promptTemplate---- | Substitute resolved blueprint variables into the user prompt body.-renderUserPrompt :: Map VarName ResolvedVar -> Text -> Text-renderUserPrompt resolved tpl =-  substitute-    [(vn.unVarName, varValueToText rv.value) | (vn, rv) <- Map.toList resolved]-    tpl---- | Local copy of @Seihou.CLI.Run.varValueToText@. Kept in sync with the--- original; if a third caller appears, lift it into Seihou.CLI.Shared.-varValueToText :: VarValue -> Text-varValueToText (VText t) = t-varValueToText (VBool True) = "true"-varValueToText (VBool False) = "false"-varValueToText (VInt n) = T.pack (show n)-varValueToText (VList vs) = T.intercalate "," (map varValueToText vs)+renderSystemPrompt :: AgentContext -> PreparedBlueprintExecution -> BaselineStatus -> Text+renderSystemPrompt ctx prepared baseline =+  let bp = prepared.preparedBlueprint+   in substitute+        [ ("cwd", ctx.cwd),+          ("seihou_project_state", formatSeihouProjectState ctx),+          ("manifest_state", formatManifestState ctx),+          ("module_dhall_state", formatModuleDhallState ctx),+          ("local_modules", formatLocalModules ctx),+          ("available_modules", formatAvailableModules ctx),+          ("blueprint_name", bp.name.unModuleName),+          ("blueprint_version", fromMaybe "(unspecified)" bp.version),+          ("blueprint_description", fromMaybe "(no description)" bp.description),+          ("baseline_status", formatBaselineStatus baseline),+          ("reference_files", prepared.preparedReferenceFiles),+          ("reference_files_dir", prepared.preparedReferenceFilesAccess),+          ("user_prompt", prepared.preparedSharedPrompt)+        ]+        promptTemplate  -- | Whether an operation targets a file in the given path set. Local -- copy of @Seihou.CLI.Run.opTargetsPath@.
src-exe/Seihou/CLI/Browse.hs view
@@ -68,8 +68,8 @@             logIO LogNormal (logError $ "failed to load blueprint: " <> T.pack (show err))             exitFailure           Right b -> do-            let bpName = case b of Blueprint nm _ _ _ _ _ _ _ _ _ -> nm-                bpDesc = case b of Blueprint _ _ d _ _ _ _ _ _ _ -> d+            let bpName = case b of Blueprint nm _ _ _ _ _ _ _ _ _ _ -> nm+                bpDesc = case b of Blueprint _ _ d _ _ _ _ _ _ _ _ -> d             TIO.putStr $ formatBrowseSingleBlueprint source bpName.unModuleName bpDesc       SinglePrompt rootDir -> do         let dhallFile = rootDir </> "prompt.dhall"
src-exe/Seihou/CLI/Commands.hs view
@@ -1,6 +1,7 @@ module Seihou.CLI.Commands   ( Command (..),     RunOpts (..),+    UpdateOpts (..),     RemoveOpts (..),     VarsOpts (..),     InstallOpts (..),@@ -22,11 +23,13 @@     MigrateOpts (..),     SchemaUpgradeOpts (..),     AgentOpts (..),+    AgentModelsOpts (..),     AgentCommand (..),     AssistOpts (..),     BootstrapOpts (..),     SetupOpts (..),     BlueprintRunOpts (..),+    BlueprintMigrationOpts (..),     PromptCommand (..),     PromptRunOpts (..),     CompletionsCommand (..),@@ -59,6 +62,7 @@ data Command   = Init   | Run RunOpts+  | Update UpdateOpts   | Remove RemoveOpts   | Vars VarsOpts   | Install InstallOpts@@ -102,15 +106,24 @@   { agentDebug :: Bool,     agentProvider :: Maybe Text,     agentModel :: Maybe Text,+    agentEffort :: Maybe Text,     agentCommand :: AgentCommand   }   deriving stock (Eq, Show, Generic) +data AgentModelsOpts = AgentModelsOpts+  { modelsProvider :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)+ data AgentCommand   = AgentAssist AssistOpts   | AgentBootstrap BootstrapOpts   | AgentSetup SetupOpts   | AgentRun BlueprintRunOpts+  | AgentMigrate BlueprintMigrationOpts+  | AgentModels AgentModelsOpts+  | AgentConfigShow   deriving stock (Eq, Show, Generic)  data RunOpts = RunOpts@@ -139,6 +152,20 @@   }   deriving stock (Eq, Show, Generic) +data UpdateOpts = UpdateOpts+  { updateTargets :: [Text],+    updateVars :: [(Text, Text)],+    updateDryRun :: Bool,+    updateJson :: Bool,+    updateReconfigure :: Bool,+    updateForce :: Bool,+    updateRunAllCommands :: Bool,+    updateNoCommands :: Bool,+    updateCommit :: Bool,+    updateCommitMessage :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)+ data RemoveOpts = RemoveOpts   { removeModule :: ModuleName,     removeDryRun :: Bool,@@ -266,7 +293,7 @@     -- 'Seihou.CLI.Migrate.runMigrate' against the *current project*     -- (cwd), if and only if that module is applied locally. Default     -- 'False'; the unset path emits a one-line advisory pointing the-    -- user at @seihou migrate@ when migrations would be pending.+    -- user at @seihou update@ when migrations would be pending.     upgradeWithMigrations :: Bool   }   deriving stock (Eq, Show, Generic)@@ -281,7 +308,8 @@ data AssistOpts = AssistOpts   { assistPrompt :: Maybe Text,     assistProvider :: Maybe Text,-    assistModel :: Maybe Text+    assistModel :: Maybe Text,+    assistEffort :: Maybe Text   }   deriving stock (Eq, Show, Generic) @@ -289,14 +317,16 @@   { bootstrapPrompt :: Maybe Text,     bootstrapRepo :: Bool,     bootstrapProvider :: Maybe Text,-    bootstrapModel :: Maybe Text+    bootstrapModel :: Maybe Text,+    bootstrapEffort :: Maybe Text   }   deriving stock (Eq, Show, Generic)  data SetupOpts = SetupOpts   { setupPrompt :: Maybe Text,     setupProvider :: Maybe Text,-    setupModel :: Maybe Text+    setupModel :: Maybe Text,+    setupEffort :: Maybe Text   }   deriving stock (Eq, Show, Generic) @@ -310,10 +340,27 @@     runBlueprintVerbose :: Bool,     runBlueprintForce :: Bool,     runBlueprintProvider :: Maybe Text,-    runBlueprintModel :: Maybe Text+    runBlueprintModel :: Maybe Text,+    runBlueprintEffort :: Maybe Text   }   deriving stock (Eq, Show, Generic) +data BlueprintMigrationOpts = BlueprintMigrationOpts+  { migrateBlueprintName :: ModuleName,+    migrateBlueprintFrom :: Text,+    migrateBlueprintTo :: Text,+    migrateBlueprintPrompt :: Maybe Text,+    migrateBlueprintVars :: [(Text, Text)],+    migrateBlueprintNamespace :: Maybe Text,+    migrateBlueprintContext :: Maybe Text,+    migrateBlueprintVerbose :: Bool,+    migrateBlueprintRerun :: Bool,+    migrateBlueprintProvider :: Maybe Text,+    migrateBlueprintModel :: Maybe Text,+    migrateBlueprintEffort :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)+ data PromptCommand   = PromptRun PromptRunOpts   deriving stock (Eq, Show, Generic)@@ -327,7 +374,8 @@     runPromptVerbose :: Bool,     runPromptDebug :: Bool,     runPromptProvider :: Maybe Text,-    runPromptModel :: Maybe Text+    runPromptModel :: Maybe Text,+    runPromptEffort :: Maybe Text   }   deriving stock (Eq, Show, Generic) @@ -356,6 +404,7 @@         vsep           [ pretty ("seihou help          # list all help topics" :: String),             pretty ("seihou help modules  # how modules work" :: String),+            pretty ("seihou help update   # safely update recorded project applications" :: String),             pretty ("seihou help migrations  # apply author-declared migrations between versions" :: String)           ],       mempty,@@ -367,6 +416,7 @@   hsubparser     ( command "init" initInfo         <> command "run" runInfo+        <> command "update" updateInfo         <> command "remove" removeInfo         <> command "status" statusInfo         <> command "diff" diffInfo@@ -440,12 +490,13 @@   info     (runParser <**> helper)     ( fullDesc-        <> progDesc "Run modules to generate a project"+        <> progDesc "Apply a module initially or reconfigure it explicitly"         <> footerDoc           ( Just $               vsep-                [ pretty ("Loads the specified module and its dependencies, resolves all variables," :: String),-                  pretty ("compiles a generation plan, and executes it in the current directory." :: String),+                [ pretty ("Applies the specified module for the first time, or deliberately" :: String),+                  pretty ("reconfigures it. Variables are resolved and a generation plan executes" :: String),+                  pretty ("in the current directory." :: String),                   line,                   pretty ("Compose multiple modules with -m/--module (repeatable). Override" :: String),                   pretty ("variables with --var KEY=VALUE (repeatable). Use --dry-run to preview" :: String),@@ -458,8 +509,9 @@                   pretty ("If an applied module's installed copy has advanced past the manifest's" :: String),                   pretty ("recorded version and ships migrations that move project files," :: String),                   pretty ("'seihou run' refuses to proceed (so it never writes new templates into" :: String),-                  pretty ("paths a migration would have moved). Run 'seihou migrate <module>'" :: String),-                  pretty ("first, or pass --with-migrations to apply pending chains in-band." :: String),+                  pretty ("paths a migration would have moved). For routine source updates, run" :: String),+                  pretty ("'seihou update <target>'. Use migrate or --with-migrations for focused" :: String),+                  pretty ("recovery and explicit reconfiguration." :: String),                   line,                   pretty ("Examples:" :: String),                   indent 2 $@@ -474,6 +526,33 @@           )     ) +updateInfo :: ParserInfo Command+updateInfo =+  info+    (updateParser <**> helper)+    ( fullDesc+        <> progDesc "Update recorded project applications safely"+        <> footerDoc+          ( Just $+              vsep+                [ pretty ("Reconciles recorded module and recipe applications with newer source" :: String),+                  pretty ("content. Saved inputs are reused, migrations are included automatically," :: String),+                  pretty ("user edits are three-way merged, and unchanged commands are skipped." :: String),+                  line,+                  pretty ("With no TARGET, updates every recorded application in manifest order." :: String),+                  pretty ("Use --dry-run to preview or --json for a non-interactive machine result." :: String),+                  pretty ("--force accepts generated conflict content but retains edited orphans." :: String),+                  line,+                  indent 2 $+                    vsep+                      [ pretty ("seihou update" :: String),+                        pretty ("seihou update master-plan --dry-run" :: String),+                        pretty ("seihou update master-plan --force --commit" :: String)+                      ]+                ]+          )+    )+ removeInfo :: ParserInfo Command removeInfo =   info@@ -584,7 +663,8 @@                   line,                   pretty ("When an applied module's installed copy has advanced past the manifest's" :: String),                   pretty ("recorded version, status reports the pending migration count under that" :: String),-                  pretty ("module's line; run 'seihou migrate <module>' to apply them." :: String)+                  pretty ("module's line. Recorded applications recommend 'seihou update <target>';" :: String),+                  pretty ("manual 'seihou migrate <module>' remains available for focused recovery." :: String)                 ]           )     )@@ -754,6 +834,42 @@             <> help "Apply any pending module migrations before the run plan; without this, 'seihou run' refuses when migrations are pending"         ) +updateParser :: Parser Command+updateParser =+  fmap Update $+    makeUpdateOpts+      <$> many (argument (T.pack <$> str) (metavar "TARGET" <> help "Recorded application target or contained module (repeatable; default: all)"))+      <*> many+        ( option+            varPair+            (long "var" <> metavar "KEY=VALUE" <> help "Variable override (repeatable)")+        )+      <*> switch (long "dry-run" <> help "Show the complete update plan without modifying managed state")+      <*> switch (long "json" <> help "Emit one JSON document and disable prompts")+      <*> switch (long "reconfigure" <> help "Ignore saved inputs and resolve them again")+      <*> switch (long "force" <> help "Use generated content for safe conflicts and retain edited orphans")+      <*> updateCommandFlags+      <*> switch (long "commit" <> help "Commit successfully updated managed paths")+      <*> optional (option (T.pack <$> str) (long "commit-message" <> metavar "MSG" <> help "Custom commit message (implies --commit)"))+  where+    makeUpdateOpts targets vars dryRun json reconfigure force (runAll, noCommands) commit commitMessage =+      UpdateOpts+        { updateTargets = targets,+          updateVars = vars,+          updateDryRun = dryRun,+          updateJson = json,+          updateReconfigure = reconfigure,+          updateForce = force,+          updateRunAllCommands = runAll,+          updateNoCommands = noCommands,+          updateCommit = commit,+          updateCommitMessage = commitMessage+        }+    updateCommandFlags =+      flag' (True, False) (long "run-all-commands" <> help "Run every generated command, including unchanged ones")+        <|> flag' (False, True) (long "no-commands" <> help "Skip every generated command")+        <|> pure (False, False)+ varsParser :: Parser Command varsParser =   fmap Vars $@@ -1066,10 +1182,9 @@                   pretty ("Example:" :: String),                   indent 2 $ pretty ("seihou outdated" :: String),                   line,-                  pretty ("Run 'seihou upgrade' to apply available updates. If a module ships" :: String),-                  pretty ("migrations, 'seihou upgrade' will surface them via an advisory; run" :: String),-                  pretty ("'seihou migrate <module>' (or 'seihou upgrade --with-migrations')" :: String),-                  pretty ("to apply them to the current project." :: String)+                  pretty ("Run 'seihou update' in an applied project to fetch and reconcile" :: String),+                  pretty ("available versions. Use 'seihou upgrade' only to refresh the shared" :: String),+                  pretty ("installed cache, or 'seihou migrate <module>' for focused recovery." :: String)                 ]           )     )@@ -1085,7 +1200,7 @@   info     (upgradeParser <**> helper)     ( fullDesc-        <> progDesc "Upgrade installed modules to latest versions"+        <> progDesc "Refresh shared installed-cache sources only"         <> footerDoc (Just upgradeFooter)     ) @@ -1105,8 +1220,9 @@ upgradeFooter :: Doc upgradeFooter =   vsep-    [ pretty ("Upgrades installed modules to the latest version available from their" :: String),+    [ pretty ("Refreshes installed-cache modules to the latest version available from their" :: String),       pretty ("source repository. Only modules installed via 'seihou install' are checked." :: String),+      pretty ("It does not reconcile the current project; use 'seihou update' for that." :: String),       pretty ("Modules without version information are upgraded by default." :: String),       pretty ("Use --skip-unversioned to skip them." :: String),       line,@@ -1128,7 +1244,7 @@         vsep           [ pretty ("Newer module versions may declare migrations that move project files" :: String),             pretty ("when applied. By default 'seihou upgrade' does not run them — it only" :: String),-            pretty ("prints an advisory pointing at 'seihou migrate <module>'. Pass" :: String),+            pretty ("prints an advisory pointing project users at 'seihou update'. Pass" :: String),             pretty ("--with-migrations to run them as part of the upgrade." :: String)           ]     ]@@ -1372,6 +1488,7 @@                 [ pretty ("Agent subcommands provide AI-assisted workflows powered by" :: String),                   pretty ("configurable CLI or API providers. Use --provider to select claude-cli, codex-cli," :: String),                   pretty ("anthropic, or openai, and --model for a provider-specific model." :: String),+                  pretty ("Run 'seihou agent models' to list known model choices." :: String),                   line,                   pretty ("Use --debug with any subcommand to print the resolved system" :: String),                   pretty ("prompt without contacting the configured provider." :: String),@@ -1382,7 +1499,9 @@                       [ pretty ("assist      AI-assisted template authoring prompt" :: String),                         pretty ("bootstrap   Bootstrap a new module or multi-module repo" :: String),                         pretty ("setup       Guided project setup: configure, run, and commit" :: String),-                        pretty ("run         Run an agent-driven blueprint" :: String)+                        pretty ("run         Run an agent-driven blueprint" :: String),+                        pretty ("migrate     Run ordered library-upgrade blueprint migrations" :: String),+                        pretty ("models      List known agent models" :: String)                       ]                 ]           )@@ -1406,9 +1525,10 @@             (T.pack <$> str)             ( long "model"                 <> metavar "MODEL"-                <> help "Agent model name or provider-specific model alias"+                <> help "Agent model name or provider-specific alias; 'seihou agent models' lists known choices"             )         )+      <*> effortOption       <*> agentCommandParser  agentCommandParser :: Parser AgentCommand@@ -1418,6 +1538,9 @@         <> command "bootstrap" agentBootstrapInfo         <> command "setup" agentSetupInfo         <> command "run" agentRunInfo+        <> command "migrate" agentMigrateInfo+        <> command "models" agentModelsInfo+        <> command "config" agentConfigInfo     )  agentAssistInfo :: ParserInfo AgentCommand@@ -1457,6 +1580,7 @@       <$> optional (argument (T.pack <$> str) (metavar "PROMPT" <> help "Initial prompt describing what you want to do"))       <*> providerOption       <*> modelOption+      <*> effortOption  agentBootstrapInfo :: ParserInfo AgentCommand agentBootstrapInfo =@@ -1494,6 +1618,7 @@       <*> switch (long "repo" <> help "Bootstrap a multi-module repository with registry")       <*> providerOption       <*> modelOption+      <*> effortOption  agentSetupInfo :: ParserInfo AgentCommand agentSetupInfo =@@ -1530,6 +1655,7 @@       <$> optional (argument (T.pack <$> str) (metavar "PROMPT" <> help "Description of what you want to set up"))       <*> providerOption       <*> modelOption+      <*> effortOption  agentRunInfo :: ParserInfo AgentCommand agentRunInfo =@@ -1584,7 +1710,112 @@       <*> switch (long "force" <> help "Auto-resolve baseline conflicts (accept new files)")       <*> providerOption       <*> modelOption+      <*> effortOption +agentMigrateInfo :: ParserInfo AgentCommand+agentMigrateInfo =+  info+    (agentMigrateParser <**> helper)+    ( fullDesc+        <> progDesc "Run ordered agent-guided migrations declared by a blueprint"+        <> footerDoc+          ( Just $+              vsep+                [ pretty ("Selects the blueprint migrations inside the explicit version window," :: String),+                  pretty ("runs one provider interaction per edge, and records each successful" :: String),+                  pretty ("edge so an interrupted chain resumes without repeating completed work." :: String),+                  line,+                  pretty ("Versions must be dotted numeric values. Gaps are allowed. Pass --rerun" :: String),+                  pretty ("to ignore matching receipts. Parent --debug prints every pending prompt" :: String),+                  pretty ("without contacting a provider or changing the manifest." :: String),+                  line,+                  pretty ("Examples:" :: String),+                  indent 2 $+                    vsep+                      [ pretty ("seihou agent migrate my-library --from 1.0.0 --to 3.0.0" :: String),+                        pretty ("seihou agent migrate my-library --from 1 --to 3 --rerun" :: String),+                        pretty ("seihou agent --debug migrate my-library --from 1.0.0 --to 3.0.0" :: String)+                      ]+                ]+          )+    )++agentMigrateParser :: Parser AgentCommand+agentMigrateParser =+  fmap AgentMigrate $+    BlueprintMigrationOpts+      <$> argument moduleNameReader (metavar "BLUEPRINT" <> help "Name of the blueprint containing migrations")+      <*> option (T.pack <$> str) (long "from" <> metavar "VERSION" <> help "Currently used library version (dotted numeric)")+      <*> option (T.pack <$> str) (long "to" <> metavar "VERSION" <> help "Desired library version (dotted numeric)")+      <*> optional (argument (T.pack <$> str) (metavar "PROMPT" <> help "Optional initial user instruction for each migration session"))+      <*> many+        ( option+            varPair+            (long "var" <> metavar "KEY=VALUE" <> help "Variable override (repeatable)")+        )+      <*> optional (option (T.pack <$> str) (long "namespace" <> metavar "NS" <> help "Override namespace for config lookup"))+      <*> optional (option (T.pack <$> str) (long "context" <> short 'c' <> metavar "CTX" <> help "Override context for config lookup"))+      <*> switch (long "verbose" <> short 'v' <> help "Show detailed progress messages")+      <*> switch (long "rerun" <> help "Run matching migrations even when a receipt already exists")+      <*> providerOption+      <*> modelOption+      <*> effortOption++agentModelsInfo :: ParserInfo AgentCommand+agentModelsInfo =+  info+    (agentModelsParser <**> helper)+    ( fullDesc+        <> progDesc "List known agent models"+        <> footerDoc+          ( Just $+              vsep+                [ pretty ("Lists the Anthropic and OpenAI models in Seihou's compiled Baikai catalog." :: String),+                  pretty ("Use --provider to filter by an API or compatible local CLI provider." :: String),+                  line,+                  pretty ("The catalog is a discovery aid, not validation. Provider-native aliases" :: String),+                  pretty ("and custom model identifiers remain accepted by --model." :: String),+                  line,+                  pretty ("Examples:" :: String),+                  indent 2 $+                    vsep+                      [ pretty ("seihou agent models" :: String),+                        pretty ("seihou agent models --provider openai" :: String),+                        pretty ("seihou agent --provider claude-cli models" :: String)+                      ]+                ]+          )+    )++agentModelsParser :: Parser AgentCommand+agentModelsParser =+  AgentModels . AgentModelsOpts <$> providerOption++agentConfigInfo :: ParserInfo AgentCommand+agentConfigInfo =+  info+    (pure AgentConfigShow <**> helper)+    ( fullDesc+        <> progDesc "Show the resolved provider and model for each agent command"+        <> footerDoc+          ( Just $+              vsep+                [ pretty ("Prints the provider and model that each agent command resolves to," :: String),+                  pretty ("labelling the source of every value: a config scope and key, an" :: String),+                  pretty ("environment variable, or the built-in default. Read-only; set values" :: String),+                  pretty ("with `seihou config set agent.<command>.model ...`." :: String),+                  line,+                  pretty ("Examples:" :: String),+                  indent 2 $+                    vsep+                      [ pretty ("seihou agent config" :: String),+                        pretty ("seihou config set agent.assist.model gpt-5-mini --global" :: String),+                        pretty ("seihou config set agent.run.model claude-opus-4-8" :: String)+                      ]+                ]+          )+    )+ promptInfo :: ParserInfo Command promptInfo =   info@@ -1664,6 +1895,7 @@       <*> switch (long "debug" <> help "Print the rendered prompt and exit")       <*> providerOption       <*> modelOption+      <*> effortOption  helpCmdInfo :: ParserInfo Command helpCmdInfo =@@ -1778,5 +2010,15 @@       (T.pack <$> str)       ( long "model"           <> metavar "MODEL"-          <> help "Agent model name or provider-specific model alias"+          <> help "Agent model name or provider-specific alias; 'seihou agent models' lists known choices"+      )++effortOption :: Parser (Maybe Text)+effortOption =+  optional $+    option+      (T.pack <$> str)+      ( long "effort"+          <> metavar "LEVEL"+          <> help "Reasoning effort: minimal, low, medium, high, xhigh, or max"       )
src-exe/Seihou/CLI/Help.hs view
@@ -38,7 +38,8 @@     HelpTopic "kit" "Manage Claude Code and Codex skills and subagents" kitContent,     HelpTopic "migrations" "Migrating a project between module versions" migrationsContent,     HelpTopic "prompts" "Reusable agent-session prompt artifacts" promptsContent,-    HelpTopic "templating" "Placeholder substitution, {{#if}} blocks, and patterns" templatingContent+    HelpTopic "templating" "Placeholder substitution, {{#if}} blocks, and patterns" templatingContent,+    HelpTopic "update" "Safely update recorded project applications" updateContent   ]  agentContent :: Text@@ -73,6 +74,9 @@  templatingContent :: Text templatingContent = $(embedStringFile "help/templating.md")++updateContent :: Text+updateContent = $(embedStringFile "help/update.md")  helpCommandParser :: Parser HelpCommand helpCommandParser =
src-exe/Seihou/CLI/Install.hs view
@@ -229,7 +229,7 @@     Right _ -> pure ()   TIO.putStrLn "  Validated blueprint definition" -  let bpVersion = case bp of Blueprint _ v _ _ _ _ _ _ _ _ -> v+  let bpVersion = case bp of Blueprint _ v _ _ _ _ _ _ _ _ _ -> v   installModuleDir rootDir name source Nothing bpVersion []   TIO.putStrLn ""   TIO.putStrLn $ "Blueprint available as: " <> T.pack name@@ -458,7 +458,7 @@                     logError $ "  failed to load " <> entry.name.unModuleName <> ": " <> T.pack (show err)                   pure False                 Right bp -> do-                  let bpVersion = case bp of Blueprint _ v _ _ _ _ _ _ _ _ -> v+                  let bpVersion = case bp of Blueprint _ v _ _ _ _ _ _ _ _ _ -> v                       ver = entry.version <|> bpVersion                   installModuleDir entryDir name source (Just repoName) ver entry.tags                   TIO.putStrLn $ "    Installed blueprint as: " <> T.pack name
src-exe/Seihou/CLI/Run.hs view
@@ -3,7 +3,8 @@   ) where -import Control.Monad (foldM, unless, when)+import Control.Exception (IOException, displayException, try)+import Control.Monad (foldM, forM_, unless, when) import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe, isJust) import Data.Set qualified as Set@@ -11,6 +12,16 @@ import Data.Text.IO qualified as TIO import Data.Time (UTCTime) import Data.Time.Clock (getCurrentTime)+import Seihou.CLI.CommandExecution+  ( CommandDisposition (..),+    CommandExecutionError (..),+    CommandPlan (..),+    CommandPolicy (..),+    PlannedCommand (..),+    executeCommandPlanWithOutput,+    finalizeCommandReceipts,+    planCommands,+  ) import Seihou.CLI.Commands (RunOpts (..)) import Seihou.CLI.CommitMessage (generateCommitMessage) import Seihou.CLI.Git (gitAdd, gitCheckIgnore, gitCommit, gitDiffCached, isGitRepo)@@ -31,12 +42,15 @@ import Seihou.Composition.Plan (compileComposedPlan) import Seihou.Composition.Recipe (expandRecipe) import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts)+import Seihou.Core.Application (attachApplication, buildAppliedComposition, mkApplicationId, replaceAppliedComposition) import Seihou.Core.Context (resolveContext) import Seihou.Core.Migration (MigrationPlan (..)) import Seihou.Core.Module (defaultSearchPaths, discoverRunnable) import Seihou.Core.Types import Seihou.Core.Variable (diagnoseResolution) import Seihou.Core.Version (renderVersion)+import Seihou.Effect.BaselineStore (pruneBaselines)+import Seihou.Effect.BaselineStoreInterp (runBaselineStore) import Seihou.Effect.ConfigReader (readContextConfig, readGlobalConfig, readLocalConfig, readNamespaceConfig) import Seihou.Effect.ConfigReaderInterp (runConfigReader) import Seihou.Effect.ConfigWriterInterp (runConfigWriter)@@ -47,8 +61,8 @@ import Seihou.Effect.Logger (logDebug, logError, logInfo, logWarn) import Seihou.Effect.ManifestStore (readManifest, writeManifest) import Seihou.Effect.ManifestStoreInterp (runManifestStore)-import Seihou.Effect.Process (runProcess) import Seihou.Effect.ProcessInterp (runProcessIO)+import Seihou.Engine.Baseline (manifestBaselineRefs, recordGeneratedBaselines) import Seihou.Engine.Conflict (resolveConflicts) import Seihou.Engine.Diff (computeDiff) import Seihou.Engine.Execute (executePlan)@@ -91,10 +105,10 @@    -- 0b. Recipe detection: check if the name resolves to a recipe or a module   searchPaths <- defaultSearchPaths-  (primaryName, allAdditional, recipeOverrides, recipeInfo) <- do+  (primaryName, allAdditional, recipeOverrides, recipeInfo, targetInfo) <- do     runnableResult <- discoverRunnable searchPaths modName     case runnableResult of-      Right (RunnableRecipe recipe _recipeDir) -> do+      Right (RunnableRecipe recipe recipeDir) -> do         case expandRecipe recipe of           Left errs -> do             logIO level $@@ -108,9 +122,21 @@             logIO level $               logInfo $                 "Recipe '" <> recipe.name.unRecipeName <> "' expanding to " <> T.pack (show (length recipe.modules)) <> " modules"-            pure (primary, recipeAdditional ++ additional, overrides, Just (recipe.name, recipe.version))-      Right (RunnableModule _ _) ->-        pure (modName, additional, Map.empty, Nothing)+            pure+              ( primary,+                recipeAdditional ++ additional,+                overrides,+                Just (recipe.name, recipe.version),+                (AppliedRecipeTarget recipe.name, recipeDir, recipe.version)+              )+      Right (RunnableModule modul moduleDir) ->+        pure+          ( modName,+            additional,+            Map.empty,+            Nothing,+            (AppliedModuleTarget modName, moduleDir, modul.version)+          )       Right (RunnableBlueprint _b _blueprintDir) -> do         -- Use the user-typed name (modName) rather than the blueprint's         -- declared name. Discovery resolves by directory name; the@@ -120,7 +146,13 @@         exitFailure       Left _ ->         -- Discovery failed — let loadComposition handle the error with its detailed message-        pure (modName, additional, Map.empty, Nothing)+        pure+          ( modName,+            additional,+            Map.empty,+            Nothing,+            (AppliedModuleTarget modName, "", Nothing)+          )    -- 1. Load all modules in the composition (primary + additional + transitive deps)   compositionResult <- loadComposition searchPaths primaryName allAdditional@@ -214,6 +246,7 @@   -- 6. Compute diff (shared by dry-run, --diff, and execution paths)   now <- getCurrentTime   let manifestPath = ".seihou" </> "manifest.json"+      baselineDir = ".seihou" </> "baselines"       planned =         [(dest, content, modName, Nothing) | WriteFileOp dest content _ <- opsFiltered]           ++ [(dest, content, mName, Just pOp) | PatchFileOp dest content pOp _ mName <- opsFiltered]@@ -240,6 +273,26 @@   manifest <-     handlePendingMigrations level runOpts manifestPath initialManifest pendings +  -- Commands are planned against the previously accepted receipts for this+  -- exact top-level application. Ordinary run deliberately remains run-all;+  -- --no-commands disables execution while retaining matching old receipts.+  let (appliedTarget, targetSource, targetVersion) = targetInfo+      currentApplicationId = mkApplicationId appliedTarget additional+      priorCommandReceipts =+        case [ application.commandReceipts+             | application <- manifest.applications,+               application.applicationId == currentApplicationId+             ] of+          receipts : _ -> receipts+          [] -> Map.empty+      commandPolicy =+        if runOpts.runNoCommands+          then DisableCommands+          else RunAllCommands+      commandPlan = planCommands commandPolicy priorCommandReceipts ops+      candidateCommandReceipts =+        finalizeCommandReceipts commandPlan [] priorCommandReceipts+   -- 6c. Compute the diff against the (possibly post-migration) manifest.   diff <- runEff $ runFilesystem $ runManifestStore manifestPath $ do     -- Diff needs every name that could own a manifest file. Each@@ -301,7 +354,9 @@                                 { hash = c.diskHash,                                   moduleName = c.moduleName,                                   strategy = Template,-                                  generatedAt = now+                                  generatedAt = now,+                                  baseline = Nothing,+                                  applicationIds = mempty                                 }                         )                       | (c, KeepCurrent) <- conflictResolved@@ -310,34 +365,93 @@                   excludePaths = Set.fromList (Map.keys keepRecords ++ skipPaths)                   opsForExec = filter (not . opTargetsPath excludePaths) opsFiltered -              -- Execute the plan (excluding kept/skipped files)-              runEff $ runFilesystem $ runManifestStore manifestPath $ do-                recs <- executePlan "" opsForExec ownerMap modName now+              -- Execute the plan (excluding kept/skipped files), capture the+              -- exact post-execution baselines, and only then publish the+              -- manifest that references those blobs.+              generationAttempt <-+                try @IOException $+                  runEff $+                    runFilesystem $+                      runBaselineStore baselineDir $+                        runManifestStore manifestPath $ do+                          recs <- executePlan "" opsForExec ownerMap modName now+                          baselineResult <- recordGeneratedBaselines "" recs+                          case baselineResult of+                            Left err -> pure (Left err)+                            Right baselineRecords -> do+                              -- Build updated manifest with all composed modules.+                              let orphanedPaths = map (.path) diff.orphaned+                                  cleanedFiles = foldr Map.delete manifest.files orphanedPaths+                                  allModuleEntries = updateAllModules manifest.modules modulesInOrder now+                                  allResolvedVals =+                                    Map.unions+                                      [Map.map (.value) vs | vs <- Map.elems resolved]+                                  appliedRecipe = case recipeInfo of+                                    Just (rName, rVersion) ->+                                      Just AppliedRecipe {name = rName, recipeVersion = rVersion, appliedAt = now}+                                    Nothing -> manifest.recipe+                                  appliedCompositionWithoutReceipts =+                                    buildAppliedComposition+                                      appliedTarget+                                      targetSource+                                      targetVersion+                                      additional+                                      (Just namespace)+                                      context+                                      modulesInOrder+                                      resolved+                                      now+                                  appliedComposition =+                                    appliedCompositionWithoutReceipts+                                      { commandReceipts = candidateCommandReceipts+                                      }+                                  applicationDestinations =+                                    Set.fromList [path | Just path <- map operationDestination opsFiltered]+                                  combinedFiles = Map.unions [baselineRecords, keepRecords, cleanedFiles]+                                  ownedFiles =+                                    Map.mapWithKey+                                      ( \path record ->+                                          if Set.member path applicationDestinations+                                            then attachApplication appliedComposition.applicationId (Map.lookup path manifest.files) record+                                            else record+                                      )+                                      combinedFiles+                                  newManifest =+                                    Manifest+                                      { version = currentManifestVersion,+                                        genAt = now,+                                        modules = allModuleEntries,+                                        vars = Map.union (Map.map varValueToText allResolvedVals) manifest.vars,+                                        files = ownedFiles,+                                        applications = replaceAppliedComposition appliedComposition manifest.applications,+                                        recipe = appliedRecipe,+                                        blueprint = manifest.blueprint,+                                        blueprintMigrations = manifest.blueprintMigrations+                                      }+                              writeManifest newManifest+                              pure (Right newManifest) -                -- Build updated manifest with all composed modules-                let orphanedPaths = map (.path) diff.orphaned-                    cleanedFiles = foldr Map.delete manifest.files orphanedPaths-                    allModuleEntries = updateAllModules manifest.modules modulesInOrder now-                    allResolvedVals =-                      Map.unions-                        [Map.map (.value) vs | vs <- Map.elems resolved]-                    appliedRecipe = case recipeInfo of-                      Just (rName, rVersion) ->-                        Just AppliedRecipe {name = rName, recipeVersion = rVersion, appliedAt = now}-                      Nothing -> manifest.recipe-                    newManifest =-                      Manifest-                        { version = currentManifestVersion,-                          genAt = now,-                          modules = allModuleEntries,-                          vars = Map.union (Map.map varValueToText allResolvedVals) manifest.vars,-                          files = Map.unions [recs, keepRecords, cleanedFiles],-                          recipe = appliedRecipe,-                          blueprint = manifest.blueprint-                        }+              newManifest <- case generationAttempt of+                Left err -> do+                  logIO level $ logError $ "Error applying files or storing generated baselines: " <> T.pack (displayException err)+                  exitFailure+                Right (Left err) -> do+                  logIO level $ logError $ "Error storing generated baselines: " <> T.pack (show err)+                  exitFailure+                Right (Right saved) -> pure saved -                -- Save manifest-                writeManifest newManifest+              -- Pruning is safe only after the new manifest is durable. A+              -- pruning failure cannot invalidate the successful generation.+              pruneAttempt <-+                try @IOException $+                  runEff $+                    runFilesystem $+                      runBaselineStore baselineDir $+                        pruneBaselines (manifestBaselineRefs newManifest)+              case pruneAttempt of+                Left err ->+                  logIO level $ logWarn $ "Warning: could not prune generated baselines: " <> T.pack (displayException err)+                Right _ -> pure ()                -- Report results               let nNew = length diff.new@@ -351,12 +465,60 @@                   <> T.pack (show nUnch)                   <> " unchanged." +              -- Execute commands after file generation. The command library+              -- returns candidate receipts only when the entire phase+              -- succeeds, so a failed run leaves the candidate manifest with+              -- no newly-minted success evidence.+              forM_ commandPlan.commands $ \planned ->+                when (planned.disposition == CommandWillRun) $+                  logIO level (logDebug $ "  run  " <> plannedCommandText planned)+              commandResult <-+                runEff $+                  runProcessIO $+                    executeCommandPlanWithOutput+                      now+                      ( \_ commandStdout _ ->+                          when (not (T.null commandStdout)) (liftIO $ TIO.putStr commandStdout)+                      )+                      commandPlan+              completedReceipts <- case commandResult of+                Right receipts -> pure receipts+                Left commandError -> do+                  when (not (T.null commandError.stdout)) $ TIO.putStr commandError.stdout+                  when (not (T.null commandError.stderr)) $ TIO.putStr commandError.stderr+                  logIO level $+                    logError $+                      "Command failed (exit "+                        <> T.pack (show commandError.exitCode)+                        <> "): "+                        <> plannedCommandText commandError.command+                  exitFailure++              let finalCommandReceipts =+                    finalizeCommandReceipts commandPlan completedReceipts priorCommandReceipts+                  receiptManifest =+                    setApplicationCommandReceipts+                      currentApplicationId+                      finalCommandReceipts+                      newManifest+              receiptWriteAttempt <-+                try @IOException $+                  runEff $+                    runFilesystem $+                      runManifestStore manifestPath $+                        writeManifest receiptManifest+              case receiptWriteAttempt of+                Left err -> do+                  logIO level $ logError $ "Commands succeeded but their receipts could not be recorded: " <> T.pack (displayException err)+                  exitFailure+                Right () -> pure ()+               -- Commit generated files if --commit or --commit-message               when (runOpts.runCommit || isJust runOpts.runCommitMessage) $ do                 let filesToStage =                       map (.path) diff.new                         ++ map (.path) diff.modified-                        ++ [manifestPath]+                        ++ [manifestPath, baselineDir]                 inGit <- runEff $ runProcessIO $ isGitRepo                 if inGit                   then do@@ -381,10 +543,6 @@                   else                     logIO level (logDebug "--commit: not inside a git repository, skipping.") -              -- Execute commands after file generation-              let commandOps = [(cmd, wd) | RunCommandOp cmd wd <- opsForExec]-              mapM_ (executeCommand level) commandOps-               -- Offer to save prompted values to local config               let prompted = collectPromptedValues resolved localMap               when (not (null prompted)) $@@ -454,7 +612,7 @@  -- | Whether an operation is a command (RunCommandOp). isCommandOp :: Operation -> Bool-isCommandOp (RunCommandOp _ _) = True+isCommandOp RunCommandOp {} = True isCommandOp _ = False  -- | Check whether an operation targets a file in the given path set.@@ -463,18 +621,32 @@ opTargetsPath paths (PatchFileOp dest _ _ _ _) = Set.member dest paths opTargetsPath _ _ = False --- | Execute a shell command via @sh -c@, printing output and halting on failure.-executeCommand :: LogLevel -> (Text, Maybe FilePath) -> IO ()-executeCommand level (cmd, workDir) = do-  logIO level (logDebug $ "  run  " <> cmd)-  (exitCode, cmdOut, cmdErr) <- runEff $ runProcessIO $ runProcess "sh" ["-c", cmd] workDir-  when (not (T.null cmdOut)) $ TIO.putStr cmdOut-  case exitCode of-    ExitSuccess -> pure ()-    ExitFailure code -> do-      when (not (T.null cmdErr)) $ TIO.putStr cmdErr-      logIO level (logError $ "Command failed (exit " <> T.pack (show code) <> "): " <> cmd)-      exitFailure+-- | Return the tracked destination produced by a file operation.+operationDestination :: Operation -> Maybe FilePath+operationDestination (WriteFileOp dest _ _) = Just dest+operationDestination (CopyFileOp _ dest) = Just dest+operationDestination (PatchFileOp dest _ _ _ _) = Just dest+operationDestination _ = Nothing++plannedCommandText :: PlannedCommand -> Text+plannedCommandText planned = case planned.operation of+  RunCommandOp {command} -> command+  _ -> "<non-command operation>"++setApplicationCommandReceipts ::+  ApplicationId ->+  Map CommandFingerprint CommandReceipt ->+  Manifest ->+  Manifest+setApplicationCommandReceipts applicationId receipts manifest =+  manifest+    { applications = map updateApplication manifest.applications+    }+  where+    updateApplication application+      | application.applicationId == applicationId =+          application {commandReceipts = receipts}+      | otherwise = application  -- | Apply the pending-migration policy. --
+ src-exe/Seihou/CLI/Update.hs view
@@ -0,0 +1,203 @@+module Seihou.CLI.Update+  ( handleUpdate,+  )+where++import Control.Monad (unless, when)+import Data.Aeson (encode, object, (.=))+import Data.ByteString.Lazy.Char8 qualified as LBS+import Data.Maybe (isJust)+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.CommandExecution (CommandPolicy (..))+import Seihou.CLI.Commands (UpdateOpts (..))+import Seihou.CLI.CommitMessage (generateCommitMessage)+import Seihou.CLI.Git (gitAdd, gitCheckIgnore, gitCommit, gitDiffCached, isGitRepo)+import Seihou.CLI.Style (useColor)+import Seihou.CLI.Update.Interaction+  ( InteractionError (..),+    InteractionMode (..),+    forceResolveUpdatePlan,+    resolveInteractively,+  )+import Seihou.CLI.Update.Render+  ( encodeUpdateOutput,+    errorOutput,+    planOutput,+    renderUpdateHuman,+    resultOutput,+  )+import Seihou.Core.Types (ModuleName (..))+import Seihou.Effect.ProcessInterp (runProcessIO)+import Seihou.Prelude+import System.Exit (ExitCode (..), exitFailure)+import System.FilePath (isAbsolute)+import System.IO (hFlush, hIsTerminalDevice, isEOF, stderr, stdin)+import "seihou-cli" Seihou.CLI.Update qualified as Service++handleUpdate :: UpdateOpts -> IO ()+handleUpdate opts = do+  validateOptions opts+  terminal <- hIsTerminalDevice stdin+  let request = requestFromOptions terminal opts+  Service.withProjectUpdate request (handlePlanned terminal opts)++validateOptions :: UpdateOpts -> IO ()+validateOptions opts+  | opts.updateDryRun && (opts.updateCommit || isJust opts.updateCommitMessage) =+      failCli opts "invalid_options" "--commit and --commit-message cannot be used with --dry-run"+  | opts.updateRunAllCommands && opts.updateNoCommands =+      failCli opts "invalid_options" "--run-all-commands and --no-commands are mutually exclusive"+  | otherwise = pure ()++requestFromOptions :: Bool -> UpdateOpts -> Service.UpdateRequest+requestFromOptions terminal opts =+  Service.UpdateRequest+    { selection =+        if null opts.updateTargets+          then Service.AllRecordedApplications+          else Service.NamedUpdateTargets opts.updateTargets,+      varOverrides = opts.updateVars,+      reconfigure = opts.updateReconfigure,+      promptPolicy =+        if terminal && not opts.updateJson+          then Service.AllowPrompts+          else Service.ForbidPrompts,+      commandPolicy =+        if opts.updateRunAllCommands+          then RunAllCommands+          else if opts.updateNoCommands then DisableCommands else RunChangedCommands,+      dryRun = opts.updateDryRun+    }++handlePlanned :: Bool -> UpdateOpts -> Either Service.UpdateError Service.UpdatePlan -> IO ()+handlePlanned _ opts (Left err) = do+  if opts.updateJson+    then LBS.putStrLn (encodeUpdateOutput (errorOutput err))+    else TIO.hPutStr stderr (renderUpdateHuman False (errorOutput err))+  exitFailure+handlePlanned terminal opts (Right originalPlan) = do+  forced <-+    if opts.updateForce+      then either (failInteraction opts) pure (forceResolveUpdatePlan originalPlan)+      else pure originalPlan+  resolved <-+    resolveInteractively+      (if terminal && not opts.updateJson then Interactive else NonInteractive)+      forced+      >>= either (failInteraction opts) pure+  color <- useColor+  if Service.isUpdateNoOp resolved+    then+      if opts.updateJson+        then LBS.putStrLn (encodeUpdateOutput (planOutput resolved))+        else TIO.putStrLn "Already up to date."+    else+      if opts.updateDryRun+        then emitPlan color opts resolved+        else do+          unless opts.updateJson $ TIO.putStr (renderUpdateHuman color (planOutput resolved))+          accepted <- if opts.updateJson then pure True else confirmApply terminal+          if not accepted+            then TIO.hPutStrLn stderr "Update cancelled; no managed state was changed."+            else do+              applied <- Service.applyProjectUpdate resolved+              case applied of+                Left err -> handlePlanned terminal opts (Left err)+                Right result -> do+                  if opts.updateJson+                    then LBS.putStrLn (encodeUpdateOutput (resultOutput result))+                    else TIO.putStr (renderUpdateHuman color (resultOutput result))+                  when (opts.updateCommit || isJust opts.updateCommitMessage) $ do+                    committed <- commitUpdate opts result+                    case committed of+                      Left err -> do+                        TIO.hPutStrLn stderr ("Update succeeded, but git commit failed: " <> err)+                        exitFailure+                      Right () -> pure ()++emitPlan :: Bool -> UpdateOpts -> Service.UpdatePlan -> IO ()+emitPlan color opts plan =+  if opts.updateJson+    then LBS.putStrLn (encodeUpdateOutput (planOutput plan))+    else TIO.putStr (renderUpdateHuman color (planOutput plan))++confirmApply :: Bool -> IO Bool+confirmApply False = pure False+confirmApply True = loop+  where+    loop = do+      TIO.hPutStr stderr "Apply? [Y/n] "+      hFlush stderr+      eof <- isEOF+      if eof+        then pure False+        else do+          answer <- T.toLower . T.strip <$> TIO.getLine+          case answer of+            "" -> pure True+            "y" -> pure True+            "yes" -> pure True+            "n" -> pure False+            "no" -> pure False+            _ -> do+              TIO.hPutStrLn stderr "Please answer yes or no."+              loop++commitUpdate :: UpdateOpts -> Service.UpdateResult -> IO (Either Text ())+commitUpdate opts result = do+  let candidates = filter (not . isAbsolute) (Set.toAscList result.touchedPaths)+  inRepo <- runEff $ runProcessIO isGitRepo+  if not inRepo+    then pure (Right ())+    else do+      ignored <- runEff $ runProcessIO $ gitCheckIgnore candidates+      let staged = filter (`notElem` ignored) candidates+      if null staged+        then pure (Right ())+        else do+          (addExit, _, addErr) <- runEff $ runProcessIO $ gitAdd staged+          case addExit of+            ExitFailure _ -> pure (Left (T.strip addErr))+            ExitSuccess -> do+              message <- case opts.updateCommitMessage of+                Just custom -> pure custom+                Nothing -> do+                  diff <- runEff $ runProcessIO gitDiffCached+                  let modules = map (ModuleName . (.name)) result.versions+                  generateCommitMessage modules diff+              (commitExit, _, commitErr) <- runEff $ runProcessIO $ gitCommit message+              pure $ case commitExit of+                ExitSuccess -> Right ()+                ExitFailure _ -> Left (T.strip commitErr)++failInteraction :: UpdateOpts -> InteractionError -> IO a+failInteraction opts err = case err of+  InteractionRequired paths ->+    failCli+      opts+      "unresolved_conflicts"+      ( "Unresolved paths require an interactive terminal or an applicable --force choice: "+          <> T.intercalate ", " (map T.pack (Set.toAscList paths))+      )+  InteractionAborted path ->+    failCli opts "update_aborted" ("Resolution aborted for " <> T.pack path)+  InteractionResolutionFailed inner ->+    failCli opts "resolution_failed" (T.pack (show inner))+  InteractionInputFailed message ->+    failCli opts "input_failed" message++failCli :: UpdateOpts -> Text -> Text -> IO a+failCli opts code message = do+  if opts.updateJson+    then+      LBS.putStrLn $+        encode $+          object+            [ "schemaVersion" .= (1 :: Int),+              "outcome" .= ("error" :: Text),+              "error" .= object ["code" .= code, "message" .= message]+            ]+    else TIO.hPutStrLn stderr ("Update failed [" <> code <> "]: " <> message)+  exitFailure
src-exe/Seihou/CLI/Upgrade.hs view
@@ -326,9 +326,7 @@           <> renderVersion plan.planFrom           <> " → "           <> renderVersion plan.planTo-          <> "); run 'seihou migrate "-          <> name-          <> "'"+          <> "); run 'seihou update' to reconcile the recorded project application"   TIO.putStrLn $ if colorEnabled then yellow msg else msg  -- | Run a migration for a single module. Reads the manifest fresh so
src/Seihou/CLI/AgentCompletion.hs view
@@ -5,8 +5,11 @@     AgentModelConfig (..),     AgentCompletionRequest (..),     defaultAgentModelConfig,+    defaultModelForProvider,     providerFromText,     providerToText,+    effortFromText,+    effortToText,     buildAgentCompletionRequest,     buildBaikaiModel,     runAgentCompletion,@@ -15,10 +18,12 @@ where  import Baikai qualified+import Baikai.Options qualified as BaikaiOptions import Baikai.Provider.Claude.Api qualified as ClaudeApi import Baikai.Provider.Claude.Cli qualified as ClaudeCli import Baikai.Provider.OpenAI.Api qualified as OpenAIApi import Baikai.Provider.OpenAI.Cli qualified as CodexCli+import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel) import Control.Exception (try) import Data.Text (Text) import Data.Text qualified as Text@@ -33,7 +38,9 @@  data AgentModelConfig = AgentModelConfig   { agentProvider :: AgentProvider,-    agentModel :: Maybe Text+    agentModel :: Maybe Text,+    -- | Reasoning effort. 'Nothing' leaves the provider/CLI default alone.+    agentEffort :: Maybe ThinkingLevel   }   deriving stock (Eq, Show) @@ -56,9 +63,44 @@ defaultAgentModelConfig =   AgentModelConfig     { agentProvider = AgentProviderClaudeCli,-      agentModel = Nothing+      agentModel = Nothing,+      agentEffort = Nothing     } +-- | Parse a reasoning-effort level name (case-insensitive) into a Baikai+-- 'ThinkingLevel'. Accepts the six canonical Baikai level names.+effortFromText :: Text -> Either Text ThinkingLevel+effortFromText raw =+  case Text.toLower (Text.strip raw) of+    "minimal" -> Right ThinkingMinimal+    "low" -> Right ThinkingLow+    "medium" -> Right ThinkingMedium+    "high" -> Right ThinkingHigh+    "xhigh" -> Right ThinkingXHigh+    "max" -> Right ThinkingMax+    other ->+      Left $+        "Unknown reasoning effort '"+          <> other+          <> "'. Expected one of: minimal, low, medium, high, xhigh, max."++-- | Render a 'ThinkingLevel' to its canonical name (via Baikai).+effortToText :: ThinkingLevel -> Text+effortToText = renderThinkingLevel++-- | The deterministic default model for a provider when the user has configured+-- none. The two local CLI providers pin a specific model so a @seihou agent@+-- session never inherits whatever model the ambient @claude@ or @codex@ session+-- happens to have active — that would be non-deterministic and could silently+-- run a token-hungry model another session left selected. The API providers+-- return 'Nothing' here; they already send an explicit model chosen in+-- 'buildBaikaiModel', so they are deterministic without a pinned default.+defaultModelForProvider :: AgentProvider -> Maybe Text+defaultModelForProvider AgentProviderClaudeCli = Just "claude-opus-4-8"+defaultModelForProvider AgentProviderCodexCli = Just "gpt-5.6-terra"+defaultModelForProvider AgentProviderAnthropic = Nothing+defaultModelForProvider AgentProviderOpenAI = Nothing+ providerFromText :: Text -> Either Text AgentProvider providerFromText raw =   case Text.toLower (Text.strip raw) of@@ -132,7 +174,8 @@           { Baikai.systemPrompt = Just req.completionSystemPrompt,             Baikai.messages = initialMessages           }-  result <- try (Baikai.completeRequest model ctx Baikai.emptyOptions) :: IO (Either Baikai.BaikaiError Baikai.Response)+      options = Baikai.emptyOptions {BaikaiOptions.thinking = req.completionModelConfig.agentEffort}+  result <- try (Baikai.completeRequest model ctx options) :: IO (Either Baikai.BaikaiError Baikai.Response)   pure $ case result of     Left err -> Left (Text.pack (show err))     Right resp ->
src/Seihou/CLI/AgentConfig.hs view
@@ -1,19 +1,52 @@ module Seihou.CLI.AgentConfig-  ( AgentConfigInputs (..),+  ( -- * Inputs+    AgentConfigInputs (..),+    baseAgentConfigInputs,++    -- * Command identity+    AgentCommandName (..),+    agentCommandSegment,+    agentCommandLabel,+    allAgentCommands,++    -- * Config keys and environment variables     agentProviderConfigKey,     agentModelConfigKey,+    agentEffortConfigKey,+    agentCommandProviderConfigKey,+    agentCommandModelConfigKey,+    agentCommandEffortConfigKey,     agentProviderEnvVar,     agentModelEnvVar,+    agentEffortEnvVar,++    -- * Provenance+    AgentConfigSource (..),+    AgentField (..),+    ResolvedAgentField (..),+    agentConfigSourceLabel,++    -- * Resolution     resolveAgentModelConfig,+    resolveAgentModelConfigFor,     loadAgentModelConfig,+    loadAgentModelConfigFor,++    -- * Whole-configuration inspection+    ResolvedCommandConfig (..),+    loadResolvedAgentConfig,   ) where +import Baikai.ThinkingLevel (ThinkingLevel) import Data.Map.Strict qualified as Map import Data.Text qualified as T import Seihou.CLI.AgentCompletion   ( AgentModelConfig (..),+    AgentProvider (..),     defaultAgentModelConfig,+    defaultModelForProvider,+    effortFromText,     providerFromText,   ) import Seihou.CLI.Shared (formatConfigError)@@ -22,45 +55,393 @@ import Seihou.Prelude import System.Environment (lookupEnv) +-- | All the raw material provider/model resolution draws on, in one record so+-- the pure resolver can be unit-tested without touching the filesystem or the+-- environment.+--+-- The two @cli*FromSubcommand@ flags record whether the (already combined)+-- winning CLI flag originated from the subcommand's own @--provider@/@--model@+-- (as opposed to the parent @seihou agent@ flag). They only affect the+-- provenance label reported for a CLI-sourced value; they never change which+-- value wins. data AgentConfigInputs = AgentConfigInputs   { cliProvider :: Maybe Text,     cliModel :: Maybe Text,+    cliEffort :: Maybe Text,+    cliProviderFromSubcommand :: Bool,+    cliModelFromSubcommand :: Bool,+    cliEffortFromSubcommand :: Bool,     envProvider :: Maybe Text,     envModel :: Maybe Text,+    envEffort :: Maybe Text,     localConfig :: Map Text Text,     globalConfig :: Map Text Text   }   deriving stock (Eq, Show) +-- | An 'AgentConfigInputs' with nothing set: no flags, no environment, empty+-- config maps. Handy as a base for tests and for callers that only populate a+-- few fields.+baseAgentConfigInputs :: AgentConfigInputs+baseAgentConfigInputs =+  AgentConfigInputs+    { cliProvider = Nothing,+      cliModel = Nothing,+      cliEffort = Nothing,+      cliProviderFromSubcommand = False,+      cliModelFromSubcommand = False,+      cliEffortFromSubcommand = False,+      envProvider = Nothing,+      envModel = Nothing,+      envEffort = Nothing,+      localConfig = Map.empty,+      globalConfig = Map.empty+    }++-- | The agent-driven commands whose provider/model can be configured+-- independently. Each maps to a config-key segment (see 'agentCommandSegment').+data AgentCommandName+  = AgentCmdAssist+  | AgentCmdBootstrap+  | AgentCmdSetup+  | AgentCmdRun+  | AgentCmdMigrate+  | AgentCmdPromptRun+  deriving stock (Eq, Show, Enum, Bounded)++-- | The token used inside per-command config keys, e.g. @"assist"@ in+-- @agent.assist.model@.+agentCommandSegment :: AgentCommandName -> Text+agentCommandSegment AgentCmdAssist = "assist"+agentCommandSegment AgentCmdBootstrap = "bootstrap"+agentCommandSegment AgentCmdSetup = "setup"+agentCommandSegment AgentCmdRun = "run"+agentCommandSegment AgentCmdMigrate = "migrate"+agentCommandSegment AgentCmdPromptRun = "prompt-run"++-- | Human-facing label for display, e.g. @"prompt run"@ for the two-word+-- @seihou prompt run@ command.+agentCommandLabel :: AgentCommandName -> Text+agentCommandLabel AgentCmdPromptRun = "prompt run"+agentCommandLabel c = agentCommandSegment c++-- | Every configurable agent command, in display order.+allAgentCommands :: [AgentCommandName]+allAgentCommands = [minBound .. maxBound]++-- | The cross-command default provider key, @agent.provider@. agentProviderConfigKey :: Text agentProviderConfigKey = "agent.provider" +-- | The cross-command default model key, @agent.model@. agentModelConfigKey :: Text agentModelConfigKey = "agent.model" +-- | The cross-command default reasoning-effort key, @agent.effort@.+agentEffortConfigKey :: Text+agentEffortConfigKey = "agent.effort"++-- | The per-command provider key, e.g. @agent.assist.provider@.+agentCommandProviderConfigKey :: AgentCommandName -> Text+agentCommandProviderConfigKey c = "agent." <> agentCommandSegment c <> ".provider"++-- | The per-command model key, e.g. @agent.run.model@.+agentCommandModelConfigKey :: AgentCommandName -> Text+agentCommandModelConfigKey c = "agent." <> agentCommandSegment c <> ".model"++-- | The per-command reasoning-effort key, e.g. @agent.run.effort@.+agentCommandEffortConfigKey :: AgentCommandName -> Text+agentCommandEffortConfigKey c = "agent." <> agentCommandSegment c <> ".effort"+ agentProviderEnvVar :: String agentProviderEnvVar = "SEIHOU_AGENT_PROVIDER"  agentModelEnvVar :: String agentModelEnvVar = "SEIHOU_AGENT_MODEL" +agentEffortEnvVar :: String+agentEffortEnvVar = "SEIHOU_AGENT_EFFORT"++-- | Which of the resolvable fields a value belongs to. Used only to build+-- provenance labels.+data AgentField = ProviderField | ModelField | EffortField+  deriving stock (Eq, Show)++-- | Where a resolved value came from, highest precedence first.+data AgentConfigSource+  = -- | @--provider@/@--model@ on the subcommand.+    SourceCliSubcommand+  | -- | @--provider@/@--model@ on @seihou agent@.+    SourceCliParent+  | -- | @SEIHOU_AGENT_PROVIDER@/@SEIHOU_AGENT_MODEL@.+    SourceEnv+  | -- | Local @agent.<command>.<field>@.+    SourceLocalCommand+  | -- | Local @agent.<field>@.+    SourceLocalDefault+  | -- | Global @agent.<command>.<field>@.+    SourceGlobalCommand+  | -- | Global @agent.<field>@.+    SourceGlobalDefault+  | -- | The hard-coded fallback (provider @claude-cli@, model unset).+    SourceBuiltinDefault+  deriving stock (Eq, Show)++-- | A resolved value paired with the source that supplied it.+data ResolvedAgentField a = ResolvedAgentField+  { resolvedValue :: a,+    resolvedSource :: AgentConfigSource+  }+  deriving stock (Eq, Show)++-- | A short human label describing where a value came from, suitable for+-- bracketed display. For config-file sources it names the concrete key that+-- won, e.g. @"local: agent.run.model"@ or @"global: agent.provider"@.+agentConfigSourceLabel :: AgentCommandName -> AgentField -> AgentConfigSource -> Text+agentConfigSourceLabel c field src =+  case src of+    SourceCliSubcommand -> "flag on subcommand"+    SourceCliParent -> "flag on `seihou agent`"+    SourceEnv -> "env: " <> T.pack (envVarName field)+    SourceLocalCommand -> "local: " <> commandKey field c+    SourceLocalDefault -> "local: " <> defaultKey field+    SourceGlobalCommand -> "global: " <> commandKey field c+    SourceGlobalDefault -> "global: " <> defaultKey field+    SourceBuiltinDefault -> "built-in default"++envVarName :: AgentField -> String+envVarName ProviderField = agentProviderEnvVar+envVarName ModelField = agentModelEnvVar+envVarName EffortField = agentEffortEnvVar++defaultKey :: AgentField -> Text+defaultKey ProviderField = agentProviderConfigKey+defaultKey ModelField = agentModelConfigKey+defaultKey EffortField = agentEffortConfigKey++commandKey :: AgentField -> AgentCommandName -> Text+commandKey ProviderField = agentCommandProviderConfigKey+commandKey ModelField = agentCommandModelConfigKey+commandKey EffortField = agentCommandEffortConfigKey++-- | The full result of resolving one command's provider and model, with+-- provenance, used by the @seihou agent config@ inspection command.+data ResolvedCommandConfig = ResolvedCommandConfig+  { rccCommand :: AgentCommandName,+    rccProvider :: ResolvedAgentField AgentProvider,+    rccModel :: ResolvedAgentField (Maybe Text),+    rccEffort :: ResolvedAgentField (Maybe ThinkingLevel)+  }+  deriving stock (Eq, Show)++-- | Flat resolver, preserved for backward compatibility. It never consults the+-- per-command config keys, so a caller with only @agent.provider@/@agent.model@+-- set (or none) gets exactly the historical behavior. resolveAgentModelConfig :: AgentConfigInputs -> Either Text AgentModelConfig resolveAgentModelConfig inputs = do   provider <--    maybe-      (Right defaultAgentModelConfig.agentProvider)-      providerFromText-      (firstNonBlank [inputs.cliProvider, inputs.envProvider, configValue inputs.localConfig agentProviderConfigKey, configValue inputs.globalConfig agentProviderConfigKey])+    resolveProvider+      [ candidate inputs.cliProvider SourceCliSubcommand,+        candidate inputs.envProvider SourceEnv,+        candidate (Map.lookup agentProviderConfigKey inputs.localConfig) SourceLocalDefault,+        candidate (Map.lookup agentProviderConfigKey inputs.globalConfig) SourceGlobalDefault+      ]+  let modelField =+        applyProviderDefaultModel provider.resolvedValue $+          resolveModel+            [ candidate inputs.cliModel SourceCliSubcommand,+              candidate inputs.envModel SourceEnv,+              candidate (Map.lookup agentModelConfigKey inputs.localConfig) SourceLocalDefault,+              candidate (Map.lookup agentModelConfigKey inputs.globalConfig) SourceGlobalDefault+            ]   pure     AgentModelConfig-      { agentProvider = provider,-        agentModel = firstNonBlank [inputs.cliModel, inputs.envModel, configValue inputs.localConfig agentModelConfigKey, configValue inputs.globalConfig agentModelConfigKey]+      { agentProvider = provider.resolvedValue,+        agentModel = modelField.resolvedValue,+        agentEffort = Nothing       } +-- | Resolve the provider, model, and reasoning effort for a specific command,+-- honoring the full precedence chain including the per-command config tiers, and+-- reporting the source of each value.+--+-- Precedence, highest first: subcommand flag, parent @agent@ flag, environment+-- variable, local @agent.<command>.<field>@, local @agent.<field>@, global+-- @agent.<command>.<field>@, global @agent.<field>@, built-in default.+resolveAgentModelConfigFor ::+  AgentCommandName ->+  AgentConfigInputs ->+  Either+    Text+    ( ResolvedAgentField AgentProvider,+      ResolvedAgentField (Maybe Text),+      ResolvedAgentField (Maybe ThinkingLevel)+    )+resolveAgentModelConfigFor c inputs = do+  provider <-+    (\p -> ResolvedAgentField p.resolvedValue p.resolvedSource)+      <$> resolveProvider (providerCandidates c inputs)+  let model = applyProviderDefaultModel provider.resolvedValue (resolveModel (modelCandidates c inputs))+  effort <- resolveEffort (effortCandidates c inputs)+  pure (provider, model, effort)++-- | When no model was configured (source is the built-in default), substitute+-- the provider's deterministic default so the two local CLI providers always+-- resolve to a concrete model instead of 'Nothing'. The source stays+-- 'SourceBuiltinDefault' — the value is a built-in, just a non-empty one.+applyProviderDefaultModel :: AgentProvider -> ResolvedAgentField (Maybe Text) -> ResolvedAgentField (Maybe Text)+applyProviderDefaultModel prov field =+  case field.resolvedValue of+    Just _ -> field+    Nothing -> case defaultModelForProvider prov of+      Just m -> field {resolvedValue = Just m}+      Nothing -> field++providerCandidates :: AgentCommandName -> AgentConfigInputs -> [(Maybe Text, AgentConfigSource)]+providerCandidates c inputs =+  [ candidate inputs.cliProvider (cliSource inputs.cliProviderFromSubcommand),+    candidate inputs.envProvider SourceEnv,+    candidate (Map.lookup (agentCommandProviderConfigKey c) inputs.localConfig) SourceLocalCommand,+    candidate (Map.lookup agentProviderConfigKey inputs.localConfig) SourceLocalDefault,+    candidate (Map.lookup (agentCommandProviderConfigKey c) inputs.globalConfig) SourceGlobalCommand,+    candidate (Map.lookup agentProviderConfigKey inputs.globalConfig) SourceGlobalDefault+  ]++modelCandidates :: AgentCommandName -> AgentConfigInputs -> [(Maybe Text, AgentConfigSource)]+modelCandidates c inputs =+  [ candidate inputs.cliModel (cliSource inputs.cliModelFromSubcommand),+    candidate inputs.envModel SourceEnv,+    candidate (Map.lookup (agentCommandModelConfigKey c) inputs.localConfig) SourceLocalCommand,+    candidate (Map.lookup agentModelConfigKey inputs.localConfig) SourceLocalDefault,+    candidate (Map.lookup (agentCommandModelConfigKey c) inputs.globalConfig) SourceGlobalCommand,+    candidate (Map.lookup agentModelConfigKey inputs.globalConfig) SourceGlobalDefault+  ]++effortCandidates :: AgentCommandName -> AgentConfigInputs -> [(Maybe Text, AgentConfigSource)]+effortCandidates c inputs =+  [ candidate inputs.cliEffort (cliSource inputs.cliEffortFromSubcommand),+    candidate inputs.envEffort SourceEnv,+    candidate (Map.lookup (agentCommandEffortConfigKey c) inputs.localConfig) SourceLocalCommand,+    candidate (Map.lookup agentEffortConfigKey inputs.localConfig) SourceLocalDefault,+    candidate (Map.lookup (agentCommandEffortConfigKey c) inputs.globalConfig) SourceGlobalCommand,+    candidate (Map.lookup agentEffortConfigKey inputs.globalConfig) SourceGlobalDefault+  ]++cliSource :: Bool -> AgentConfigSource+cliSource True = SourceCliSubcommand+cliSource False = SourceCliParent++-- | Resolve a provider from an ordered candidate list, parsing the winning text+-- and falling back to the built-in default provider when nothing is set.+resolveProvider :: [(Maybe Text, AgentConfigSource)] -> Either Text (ResolvedAgentField AgentProvider)+resolveProvider candidates =+  case firstNonBlankWithSource candidates of+    Just (txt, src) -> (\p -> ResolvedAgentField p src) <$> providerFromText txt+    Nothing -> Right (ResolvedAgentField defaultAgentModelConfig.agentProvider SourceBuiltinDefault)++-- | Resolve a model from an ordered candidate list. An unset model resolves to+-- 'Nothing' with source 'SourceBuiltinDefault', letting the provider pick.+resolveModel :: [(Maybe Text, AgentConfigSource)] -> ResolvedAgentField (Maybe Text)+resolveModel candidates =+  case firstNonBlankWithSource candidates of+    Just (txt, src) -> ResolvedAgentField (Just txt) src+    Nothing -> ResolvedAgentField Nothing SourceBuiltinDefault++-- | Resolve a reasoning effort from an ordered candidate list. The winning text+-- is parsed with 'effortFromText'; a parse failure returns 'Left'. An unset+-- effort resolves to 'Nothing' with source 'SourceBuiltinDefault', which leaves+-- the provider/CLI default untouched.+resolveEffort :: [(Maybe Text, AgentConfigSource)] -> Either Text (ResolvedAgentField (Maybe ThinkingLevel))+resolveEffort candidates =+  case firstNonBlankWithSource candidates of+    Just (txt, src) -> (\lvl -> ResolvedAgentField (Just lvl) src) <$> effortFromText txt+    Nothing -> Right (ResolvedAgentField Nothing SourceBuiltinDefault)++candidate :: Maybe Text -> AgentConfigSource -> (Maybe Text, AgentConfigSource)+candidate value src = (value, src)++-- | The leftmost candidate whose value is present and non-blank (whitespace is+-- stripped, and @""@ counts as absent), together with its source.+firstNonBlankWithSource :: [(Maybe Text, AgentConfigSource)] -> Maybe (Text, AgentConfigSource)+firstNonBlankWithSource =+  foldr step Nothing+  where+    step (value, src) acc =+      case T.strip <$> value of+        Just "" -> acc+        Just stripped -> Just (stripped, src)+        Nothing -> acc++-- | Read the two environment variables and the local + global config, then run+-- the flat resolver. Preserved for backward compatibility. loadAgentModelConfig :: Maybe Text -> Maybe Text -> IO (Either Text AgentModelConfig) loadAgentModelConfig cliProvider cliModel = do+  inputsOrErr <- gatherAgentConfigInputs cliProvider cliModel Nothing False False False+  pure (inputsOrErr >>= resolveAgentModelConfig)++-- | Read the environment and config, then resolve provider/model/effort for a+-- specific command, projecting away the provenance the command handler does not+-- need.+loadAgentModelConfigFor ::+  AgentCommandName ->+  -- | winning provider flag (subcommand @<|>@ parent)+  Maybe Text ->+  -- | winning model flag+  Maybe Text ->+  -- | winning effort flag+  Maybe Text ->+  -- | provider flag came from the subcommand?+  Bool ->+  -- | model flag came from the subcommand?+  Bool ->+  -- | effort flag came from the subcommand?+  Bool ->+  IO (Either Text AgentModelConfig)+loadAgentModelConfigFor c cliProvider cliModel cliEffort providerFromSub modelFromSub effortFromSub = do+  inputsOrErr <- gatherAgentConfigInputs cliProvider cliModel cliEffort providerFromSub modelFromSub effortFromSub+  pure $ do+    inputs <- inputsOrErr+    (provider, model, effort) <- resolveAgentModelConfigFor c inputs+    pure+      AgentModelConfig+        { agentProvider = provider.resolvedValue,+          agentModel = model.resolvedValue,+          agentEffort = effort.resolvedValue+        }++-- | Resolve every configurable command from the real environment and config,+-- with no CLI flags, for the @seihou agent config@ inspection view.+loadResolvedAgentConfig :: IO (Either Text [ResolvedCommandConfig])+loadResolvedAgentConfig = do+  inputsOrErr <- gatherAgentConfigInputs Nothing Nothing Nothing False False False+  pure $ do+    inputs <- inputsOrErr+    traverse (resolveOne inputs) allAgentCommands+  where+    resolveOne inputs c = do+      (provider, model, effort) <- resolveAgentModelConfigFor c inputs+      pure+        ResolvedCommandConfig+          { rccCommand = c,+            rccProvider = provider,+            rccModel = model,+            rccEffort = effort+          }++-- | Shared IO: read @SEIHOU_AGENT_*@ and the local + global config maps into an+-- 'AgentConfigInputs'. Any config read error surfaces as 'Left'.+gatherAgentConfigInputs ::+  Maybe Text ->+  Maybe Text ->+  Maybe Text ->+  Bool ->+  Bool ->+  Bool ->+  IO (Either Text AgentConfigInputs)+gatherAgentConfigInputs cliProvider cliModel cliEffort providerFromSub modelFromSub effortFromSub = do   envProvider <- fmap T.pack <$> lookupEnv agentProviderEnvVar   envModel <- fmap T.pack <$> lookupEnv agentModelEnvVar+  envEffort <- fmap T.pack <$> lookupEnv agentEffortEnvVar   (localResult, globalResult) <- runEff $ runConfigReader $ do     local <- readLocalConfig     global <- readGlobalConfig@@ -68,26 +449,17 @@   pure $ do     local <- first formatConfigError localResult     global <- first formatConfigError globalResult-    resolveAgentModelConfig+    pure       AgentConfigInputs         { cliProvider = cliProvider,           cliModel = cliModel,+          cliEffort = cliEffort,+          cliProviderFromSubcommand = providerFromSub,+          cliModelFromSubcommand = modelFromSub,+          cliEffortFromSubcommand = effortFromSub,           envProvider = envProvider,           envModel = envModel,+          envEffort = envEffort,           localConfig = local,           globalConfig = global         }--configValue :: Map Text Text -> Text -> Maybe Text-configValue config key = Map.lookup key config--firstNonBlank :: [Maybe Text] -> Maybe Text-firstNonBlank =-  foldr-    ( \candidate acc ->-        case T.strip <$> candidate of-          Just "" -> acc-          Just value -> Just value-          Nothing -> acc-    )-    Nothing
+ src/Seihou/CLI/AgentConfigShow.hs view
@@ -0,0 +1,108 @@+module Seihou.CLI.AgentConfigShow+  ( handleAgentConfigShow,+    formatResolvedAgentConfig,+  )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.AgentCompletion (effortToText, providerToText)+import Seihou.CLI.AgentConfig+  ( AgentField (..),+    ResolvedAgentField (..),+    ResolvedCommandConfig (..),+    agentCommandLabel,+    agentConfigSourceLabel,+    loadResolvedAgentConfig,+  )+import Seihou.Prelude+import System.Exit (exitFailure)++-- | @seihou agent config@: read the real environment and config, resolve the+-- provider, model, and reasoning effort for every agent command, and print a+-- table labelling the source that supplied each value, followed by the+-- precedence legend.+handleAgentConfigShow :: IO ()+handleAgentConfigShow = do+  result <- loadResolvedAgentConfig+  case result of+    Left err -> do+      TIO.putStrLn $ "Error: " <> err+      exitFailure+    Right resolved -> TIO.putStr (formatResolvedAgentConfig resolved)++-- | Render the resolved per-command configuration as the displayed block. Pure,+-- so it is unit-testable without touching the filesystem.+formatResolvedAgentConfig :: [ResolvedCommandConfig] -> Text+formatResolvedAgentConfig resolved =+  T.unlines $+    [ "Resolved agent provider, model, and effort per command",+      "(highest-precedence source wins; see precedence list below)",+      ""+    ]+      <> concatMap renderCommand resolved+      <> ["", precedenceLegend]+  where+    labelWidth = maximum (0 : map (\rcc -> T.length (agentCommandLabel rcc.rccCommand)) resolved)+    valueWidth = maximum (0 : concatMap commandValueWidths resolved)++    commandValueWidths rcc =+      [ T.length (providerValue rcc),+        T.length (modelValue rcc),+        T.length (effortValue rcc)+      ]++    providerValue rcc = providerToText rcc.rccProvider.resolvedValue+    modelValue rcc = maybe "(default)" id rcc.rccModel.resolvedValue+    effortValue rcc = maybe "(default)" effortToText rcc.rccEffort.resolvedValue++    renderCommand rcc =+      let cmd = rcc.rccCommand+          label = agentCommandLabel cmd+       in [ row+              (padRight labelWidth label)+              "provider"+              (providerValue rcc)+              (agentConfigSourceLabel cmd ProviderField rcc.rccProvider.resolvedSource),+            row+              (padRight labelWidth "")+              "model   "+              (modelValue rcc)+              (agentConfigSourceLabel cmd ModelField rcc.rccModel.resolvedSource),+            row+              (padRight labelWidth "")+              "effort  "+              (effortValue rcc)+              (agentConfigSourceLabel cmd EffortField rcc.rccEffort.resolvedSource)+          ]++    row label field value sourceLabel =+      "  "+        <> label+        <> "  "+        <> field+        <> "  "+        <> padRight valueWidth value+        <> "  ["+        <> sourceLabel+        <> "]"++padRight :: Int -> Text -> Text+padRight width value = value <> T.replicate (max 0 (width - T.length value)) " "++precedenceLegend :: Text+precedenceLegend =+  T.intercalate+    "\n"+    [ "Precedence, highest first:",+      "  1. --provider / --model / --effort flag on the subcommand",+      "  2. --provider / --model / --effort flag on `seihou agent`",+      "  3. SEIHOU_AGENT_PROVIDER / SEIHOU_AGENT_MODEL / SEIHOU_AGENT_EFFORT environment variables",+      "  4. local  .seihou/config.dhall          agent.<command>.{provider,model,effort}",+      "  5. local  .seihou/config.dhall          agent.{provider,model,effort}",+      "  6. global ~/.config/seihou/config.dhall  agent.<command>.{provider,model,effort}",+      "  7. global ~/.config/seihou/config.dhall  agent.{provider,model,effort}",+      "  8. built-in default: provider claude-cli; model pinned per provider",+      "     (claude-cli -> claude-opus-4-8, codex-cli -> gpt-5.6-terra); effort unset",+      "     (the CLI/provider chooses its own reasoning effort)"+    ]
+ src/Seihou/CLI/AgentModels.hs view
@@ -0,0 +1,103 @@+module Seihou.CLI.AgentModels+  ( availableAgentModels,+    providersForModel,+    filterAgentModels,+    formatAgentModels,+  )+where++import Baikai.Model (Model)+import Baikai.Model qualified as BaikaiModel+import Baikai.Models.Generated qualified as Models+import Data.List (sortOn)+import Data.Text (Text)+import Data.Text qualified as Text+import Seihou.CLI.AgentCompletion+  ( AgentProvider (..),+    providerToText,+  )++availableAgentModels :: [Model]+availableAgentModels =+  [ Models.anthropic_claude_fable_5,+    Models.anthropic_claude_haiku_4_5,+    Models.anthropic_claude_opus_4_5,+    Models.anthropic_claude_opus_4_6,+    Models.anthropic_claude_opus_4_7,+    Models.anthropic_claude_opus_4_8,+    Models.anthropic_claude_sonnet_4_5,+    Models.anthropic_claude_sonnet_4_6,+    Models.anthropic_claude_sonnet_5,+    Models.openai_gpt_4_1,+    Models.openai_gpt_4_1_mini,+    Models.openai_gpt_4_1_nano,+    Models.openai_gpt_4o,+    Models.openai_gpt_4o_mini,+    Models.openai_gpt_5,+    Models.openai_gpt_5_1,+    Models.openai_gpt_5_2,+    Models.openai_gpt_5_4,+    Models.openai_gpt_5_4_mini,+    Models.openai_gpt_5_4_nano,+    Models.openai_gpt_5_5,+    Models.openai_gpt_5_6,+    Models.openai_gpt_5_6_luna,+    Models.openai_gpt_5_6_sol,+    Models.openai_gpt_5_6_terra,+    Models.openai_gpt_5_mini,+    Models.openai_gpt_5_nano,+    Models.openai_o1,+    Models.openai_o3,+    Models.openai_o3_mini,+    Models.openai_o4_mini+  ]++providersForModel :: Model -> [AgentProvider]+providersForModel model =+  case BaikaiModel.provider model of+    "anthropic" -> [AgentProviderAnthropic, AgentProviderClaudeCli]+    "openai" -> [AgentProviderOpenAI, AgentProviderCodexCli]+    _ -> []++filterAgentModels :: Maybe AgentProvider -> [Model] -> [Model]+filterAgentModels Nothing = id+filterAgentModels (Just provider) =+  filter (elem provider . providersForModel)++formatAgentModels :: Maybe AgentProvider -> [Model] -> Text+formatAgentModels providerFilter models =+  Text.unlines $+    [ "Available agent models:",+      "",+      formatRow modelWidth nameWidth "MODEL" "NAME" "PROVIDERS"+    ]+      <> map formatModel sortedModels+      <> [ "",+           Text.pack (show (length sortedModels)) <> " models found.",+           "Provider-specific aliases and custom model IDs remain accepted by --model."+         ]+  where+    sortedModels =+      sortOn+        (\model -> (BaikaiModel.provider model, BaikaiModel.modelId model))+        (filterAgentModels providerFilter models)+    modelWidth = maximum (Text.length "MODEL" : map (Text.length . BaikaiModel.modelId) sortedModels)+    nameWidth = maximum (Text.length "NAME" : map (Text.length . BaikaiModel.name) sortedModels)+    formatModel model =+      formatRow+        modelWidth+        nameWidth+        (BaikaiModel.modelId model)+        (BaikaiModel.name model)+        (Text.intercalate ", " (map providerToText (providersForModel model)))++formatRow :: Int -> Int -> Text -> Text -> Text -> Text+formatRow modelWidth nameWidth model name providers =+  padRight modelWidth model+    <> "  "+    <> padRight nameWidth name+    <> "  "+    <> providers++padRight :: Int -> Text -> Text+padRight width value = value <> Text.replicate (width - Text.length value) " "
+ src/Seihou/CLI/AppliedBlueprintMigration.hs view
@@ -0,0 +1,31 @@+-- | Durable manifest receipts for agent-guided blueprint migrations.+module Seihou.CLI.AppliedBlueprintMigration+  ( recordAppliedBlueprintMigration,+  )+where++import Seihou.Core.Types (AppliedBlueprintMigration (..))+import Seihou.Effect.Filesystem (createDirectoryIfMissing)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.ManifestStore (readManifest, writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Manifest.Types (emptyManifest, writeAppliedBlueprintMigration)+import Seihou.Prelude+import System.FilePath (takeDirectory)++-- | Read or create the project manifest, upsert one exact migration receipt,+-- and write it atomically. A corrupt existing manifest is reported and left+-- untouched rather than being replaced.+recordAppliedBlueprintMigration :: FilePath -> AppliedBlueprintMigration -> IO (Either Text ())+recordAppliedBlueprintMigration manifestPath receipt =+  runEff $ runFilesystem $ runManifestStore manifestPath $ do+    createDirectoryIfMissing True (takeDirectory manifestPath)+    mManifest <- readManifest+    case mManifest of+      Right (Just manifest) -> do+        writeManifest (writeAppliedBlueprintMigration receipt manifest)+        pure (Right ())+      Right Nothing -> do+        writeManifest (writeAppliedBlueprintMigration receipt (emptyManifest receipt.appliedAt))+        pure (Right ())+      Left err -> pure (Left err)
+ src/Seihou/CLI/BlueprintExecution.hs view
@@ -0,0 +1,165 @@+-- | Shared preparation for normal and migration blueprint execution.+--+-- This module deliberately knows nothing about executable command options or+-- provider processes. It resolves the blueprint's variables through Seihou's+-- standard precedence chain, prepares reference-file access, and renders the+-- shared blueprint prompt once for downstream execution modes.+module Seihou.CLI.BlueprintExecution+  ( BlueprintExecutionRequest (..),+    PreparedBlueprintExecution (..),+    prepareBlueprintExecution,+    renderBlueprintText,+    varValueToText,+  )+where++import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Seihou.CLI.AgentLaunch+  ( formatReferenceFiles,+    formatReferenceFilesDir,+    resolveBlueprintTools,+  )+import Seihou.CLI.Shared+  ( deriveNamespace,+    toVarNameMap,+    unwrapConfig,+  )+import Seihou.Composition.Instance (primaryInstance)+import Seihou.Composition.Resolve (resolveWithPrompts)+import Seihou.Core.Context (resolveContext)+import Seihou.Core.Types+import Seihou.Effect.ConfigReader+  ( readContextConfig,+    readGlobalConfig,+    readLocalConfig,+    readNamespaceConfig,+  )+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Effect.ConsoleInterp (runConsole)+import Seihou.Prelude+import System.Directory (doesDirectoryExist, makeAbsolute)+import System.Environment (getEnvironment)++-- | Inputs shared by normal blueprint runs and blueprint migrations.+-- Provider capability is represented as a boolean so this library module does+-- not need to know about Baikai or the executable command model.+data BlueprintExecutionRequest = BlueprintExecutionRequest+  { executionBlueprint :: Blueprint,+    executionBlueprintDir :: FilePath,+    executionVariableOverrides :: [(Text, Text)],+    executionNamespaceOverride :: Maybe Text,+    executionContextOverride :: Maybe Text,+    executionCanMountFiles :: Bool,+    executionLogLevel :: LogLevel+  }+  deriving stock (Eq, Show)++-- | Prepared state that both execution modes consume. The mounted path is+-- absolute when present; the access text preserves the existing API-provider+-- explanation when local files cannot be mounted.+data PreparedBlueprintExecution = PreparedBlueprintExecution+  { preparedBlueprint :: Blueprint,+    preparedBlueprintDir :: FilePath,+    preparedResolvedVariables :: Map VarName ResolvedVar,+    preparedMountedFilesDir :: Maybe FilePath,+    preparedReferenceFiles :: Text,+    preparedReferenceFilesAccess :: Text,+    preparedSharedPrompt :: Text,+    preparedAllowedTools :: [String]+  }+  deriving stock (Eq, Show)++-- | Resolve one blueprint through the same CLI/environment/config/prompt+-- precedence used by @seihou run@ and the existing agent runner.+prepareBlueprintExecution ::+  BlueprintExecutionRequest ->+  IO (Either [VarError] PreparedBlueprintExecution)+prepareBlueprintExecution request = do+  let bp = request.executionBlueprint+      blueprintDir = request.executionBlueprintDir+      filesDir = blueprintDir </> "files"+  filesExist <- doesDirectoryExist filesDir+  mountedFilesDir <-+    if filesExist && request.executionCanMountFiles+      then Just <$> makeAbsolute filesDir+      else pure Nothing++  let placeholderModule =+        Module+          { name = bp.name,+            version = bp.version,+            description = bp.description,+            vars = bp.vars,+            exports = [],+            prompts = bp.prompts,+            steps = [],+            commands = [],+            dependencies = [],+            removal = Nothing,+            migrations = []+          }+      placeholderInst = primaryInstance bp.name+      placeholderTriple = (placeholderInst, placeholderModule, blueprintDir)++  envPairs <- getEnvironment+  let cliOverrides =+        Map.fromList+          [(VarName key, value) | (key, value) <- request.executionVariableOverrides]+      envVars = Map.fromList [(T.pack key, T.pack value) | (key, value) <- envPairs]+      namespace =+        fromMaybe (deriveNamespace bp.name) request.executionNamespaceOverride+  context <- resolveContext request.executionContextOverride envVars+  let contextName = fromMaybe "" context++  resolveResult <- runEff $ runConfigReader $ runConsole $ do+    localCfg <- readLocalConfig >>= unwrapConfig request.executionLogLevel+    nsCfg <- readNamespaceConfig namespace >>= unwrapConfig request.executionLogLevel+    ctxCfg <- readContextConfig contextName >>= unwrapConfig request.executionLogLevel+    globalCfg <- readGlobalConfig >>= unwrapConfig request.executionLogLevel+    resolveWithPrompts+      [placeholderTriple]+      cliOverrides+      envVars+      namespace+      contextName+      (toVarNameMap localCfg)+      (toVarNameMap nsCfg)+      (toVarNameMap ctxCfg)+      (toVarNameMap globalCfg)++  pure $ do+    allResolved <- resolveResult+    let resolved = Map.findWithDefault Map.empty placeholderInst allResolved+    Right+      PreparedBlueprintExecution+        { preparedBlueprint = bp,+          preparedBlueprintDir = blueprintDir,+          preparedResolvedVariables = resolved,+          preparedMountedFilesDir = mountedFilesDir,+          preparedReferenceFiles = formatReferenceFiles bp.files,+          preparedReferenceFilesAccess = formatReferenceFilesDir mountedFilesDir,+          preparedSharedPrompt = renderBlueprintText resolved bp.prompt,+          preparedAllowedTools = resolveBlueprintTools bp.allowedTools+        }++-- | Substitute resolved blueprint variables into any blueprint-owned text.+renderBlueprintText :: Map VarName ResolvedVar -> Text -> Text+renderBlueprintText resolved template =+  foldl'+    ( \rendered (name, value) ->+        T.replace+          ("{{" <> name.unVarName <> "}}")+          (varValueToText value.value)+          rendered+    )+    template+    (Map.toList resolved)++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)
+ src/Seihou/CLI/BlueprintMigration.hs view
@@ -0,0 +1,174 @@+-- | Pure selection/rendering and callback-driven execution for ordered+-- agent-guided blueprint migrations.+module Seihou.CLI.BlueprintMigration+  ( BlueprintMigrationLaunchFailure (..),+    BlueprintMigrationRunResult (..),+    renderBlueprintMigrationInstruction,+    renderBlueprintMigrationSystemPrompt,+    formatBlueprintMigrationDebugOutput,+    pendingBlueprintMigrations,+    runBlueprintMigrationsWith,+  )+where++import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Seihou.CLI.AgentLaunch+  ( AgentContext (..),+    formatAvailableModules,+    formatLocalModules,+    formatManifestState,+    formatModuleDhallState,+    formatSeihouProjectState,+    substitute,+  )+import Seihou.CLI.BlueprintExecution+  ( PreparedBlueprintExecution (..),+    renderBlueprintText,+  )+import Seihou.Core.Migration+  ( BlueprintMigration (..),+    BlueprintMigrationPlan (..),+  )+import Seihou.Core.Types+  ( AppliedBlueprintMigration (..),+    Blueprint (..),+    ModuleName (..),+    ResolvedVar,+    VarName,+  )+import Seihou.Prelude+import System.Exit (ExitCode)++-- | Provider failures retain either a real interactive process exit or API+-- error text rather than collapsing both paths into an artificial exit code.+data BlueprintMigrationLaunchFailure+  = BlueprintMigrationProcessFailure ExitCode+  | BlueprintMigrationProviderFailure Text+  deriving stock (Eq, Show)++-- | Terminal outcome for one pending migration chain.+data BlueprintMigrationRunResult+  = BlueprintMigrationNoWork+  | BlueprintMigrationComplete [BlueprintMigration]+  | BlueprintMigrationLaunchFailed BlueprintMigration BlueprintMigrationLaunchFailure+  | BlueprintMigrationRecordFailed BlueprintMigration Text+  deriving stock (Eq, Show)++-- | Render the edge-specific instruction with the same resolved variables as+-- the blueprint's shared prompt.+renderBlueprintMigrationInstruction ::+  Map VarName ResolvedVar ->+  BlueprintMigration ->+  Text+renderBlueprintMigrationInstruction resolved migration =+  renderBlueprintText resolved migration.prompt++-- | Fill the migration-specific embedded template. The template itself stays+-- in the executable target because @Data.FileEmbed@ traps it there; accepting+-- it as an argument keeps all rendering policy pure and unit-testable here.+renderBlueprintMigrationSystemPrompt ::+  Text ->+  AgentContext ->+  PreparedBlueprintExecution ->+  Int ->+  Int ->+  BlueprintMigration ->+  Text+renderBlueprintMigrationSystemPrompt template ctx prepared position total migration =+  let blueprint = prepared.preparedBlueprint+      renderedInstruction =+        renderBlueprintMigrationInstruction prepared.preparedResolvedVariables migration+   in substitute+        [ ("cwd", ctx.cwd),+          ("seihou_project_state", formatSeihouProjectState ctx),+          ("manifest_state", formatManifestState ctx),+          ("module_dhall_state", formatModuleDhallState ctx),+          ("local_modules", formatLocalModules ctx),+          ("available_modules", formatAvailableModules ctx),+          ("blueprint_name", blueprint.name.unModuleName),+          ("blueprint_version", fromMaybe "(unspecified)" blueprint.version),+          ("blueprint_description", fromMaybe "(no description)" blueprint.description),+          ("migration_from", migration.from),+          ("migration_to", migration.to),+          ("migration_position", T.pack (show position)),+          ("migration_total", T.pack (show total)),+          ("reference_files", prepared.preparedReferenceFiles),+          ("reference_files_dir", prepared.preparedReferenceFilesAccess),+          ("shared_prompt", prepared.preparedSharedPrompt),+          ("migration_prompt", renderedInstruction)+        ]+        template++-- | Clearly delimit every pending prompt for parent debug mode. This pure+-- function cannot launch a provider or receive a recorder, which makes the+-- migration debug path structurally read-only.+formatBlueprintMigrationDebugOutput ::+  (Int -> Int -> BlueprintMigration -> Text) ->+  [BlueprintMigration] ->+  Text+formatBlueprintMigrationDebugOutput render migrations =+  T.intercalate+    "\n\n"+    [ T.unlines+        [ "===== ["+            <> T.pack (show position)+            <> "/"+            <> T.pack (show total)+            <> "] "+            <> migration.from+            <> " -> "+            <> migration.to+            <> " =====",+          render position total migration+        ]+    | (position, migration) <- zip [1 ..] migrations+    ]+  where+    total = length migrations++-- | Remove exact-edge receipts while retaining planner order. Artifact+-- versions and timestamps are intentionally not part of the completion key.+pendingBlueprintMigrations ::+  Bool ->+  ModuleName ->+  [AppliedBlueprintMigration] ->+  BlueprintMigrationPlan ->+  [BlueprintMigration]+pendingBlueprintMigrations rerun blueprintName receipts plan+  | rerun = plan.blueprintPlanSteps+  | otherwise = filter (not . alreadyApplied) plan.blueprintPlanSteps+  where+    alreadyApplied migration =+      any+        ( \receipt ->+            receipt.name == blueprintName+              && receipt.fromVersion == migration.from+              && receipt.toVersion == migration.to+        )+        receipts++-- | Launch and record one pending edge at a time. A receipt is requested only+-- after its launch succeeds, and either callback failure stops the chain before+-- the next launch.+runBlueprintMigrationsWith ::+  (Int -> Int -> BlueprintMigration -> IO (Either BlueprintMigrationLaunchFailure ())) ->+  (BlueprintMigration -> IO (Either Text ())) ->+  [BlueprintMigration] ->+  IO BlueprintMigrationRunResult+runBlueprintMigrationsWith _launch _record [] = pure BlueprintMigrationNoWork+runBlueprintMigrationsWith launch record migrations =+  go [] (zip [1 ..] migrations)+  where+    total = length migrations++    go completed [] = pure (BlueprintMigrationComplete (reverse completed))+    go completed ((position, migration) : rest) = do+      launchResult <- launch position total migration+      case launchResult of+        Left failure -> pure (BlueprintMigrationLaunchFailed migration failure)+        Right () -> do+          recordResult <- record migration+          case recordResult of+            Left err -> pure (BlueprintMigrationRecordFailed migration err)+            Right () -> go (migration : completed) rest
+ src/Seihou/CLI/CommandExecution.hs view
@@ -0,0 +1,189 @@+module Seihou.CLI.CommandExecution+  ( CommandPolicy (..),+    CommandDisposition (..),+    PlannedCommand (..),+    CommandPlan (..),+    CommandPlanSummary (..),+    CommandExecutionError (..),+    planCommands,+    summarizeCommandPlan,+    executeCommandPlan,+    executeCommandPlanWithOutput,+    finalizeCommandReceipts,+  )+where++import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Time (UTCTime)+import Seihou.Core.CommandFingerprint (fingerprintCommand)+import Seihou.Core.Types+import Seihou.Effect.Process (Process, runProcess)+import Seihou.Prelude+import System.Exit (ExitCode (..))++-- | Whether a command phase runs every declaration, only declarations that+-- lack a successful receipt, or no declarations.+data CommandPolicy+  = RunAllCommands+  | RunChangedCommands+  | DisableCommands+  deriving stock (Eq, Show)++-- | The action selected for one rendered command.+data CommandDisposition+  = CommandWillRun+  | CommandSkippedUnchanged+  | CommandSkippedDisabled+  deriving stock (Eq, Show)++-- | A rendered command paired with its stable identity and selected action.+data PlannedCommand = PlannedCommand+  { operation :: Operation,+    fingerprint :: CommandFingerprint,+    disposition :: CommandDisposition+  }+  deriving stock (Eq, Show)++-- | An ordered command phase. Declaration/composition order is also execution+-- order.+newtype CommandPlan = CommandPlan+  { commands :: [PlannedCommand]+  }+  deriving stock (Eq, Show)++-- | Counts suitable for human or machine-readable previews.+data CommandPlanSummary = CommandPlanSummary+  { willRun :: Int,+    skippedUnchanged :: Int,+    skippedDisabled :: Int+  }+  deriving stock (Eq, Show)++-- | A failed shell command and its captured process result.+data CommandExecutionError = CommandExecutionError+  { command :: PlannedCommand,+    exitCode :: Int,+    stdout :: Text,+    stderr :: Text+  }+  deriving stock (Eq, Show)++-- | Select command dispositions according to policy and prior successful+-- receipts. Non-command operations are ignored.+planCommands ::+  CommandPolicy ->+  Map CommandFingerprint CommandReceipt ->+  [Operation] ->+  CommandPlan+planCommands policy priorReceipts =+  CommandPlan . mapMaybe planOne+  where+    planOne operation = do+      fingerprint <- fingerprintCommand operation+      let disposition = case policy of+            RunAllCommands -> CommandWillRun+            RunChangedCommands+              | Map.member fingerprint priorReceipts -> CommandSkippedUnchanged+              | otherwise -> CommandWillRun+            DisableCommands -> CommandSkippedDisabled+      pure PlannedCommand {operation, fingerprint, disposition}++-- | Count each command disposition without changing command order.+summarizeCommandPlan :: CommandPlan -> CommandPlanSummary+summarizeCommandPlan commandPlan =+  foldl' count emptySummary commandPlan.commands+  where+    emptySummary = CommandPlanSummary {willRun = 0, skippedUnchanged = 0, skippedDisabled = 0}+    count summary planned = case planned.disposition of+      CommandWillRun -> summary {willRun = summary.willRun + 1}+      CommandSkippedUnchanged -> summary {skippedUnchanged = summary.skippedUnchanged + 1}+      CommandSkippedDisabled -> summary {skippedDisabled = summary.skippedDisabled + 1}++-- | Execute runnable commands sequentially with @sh -c@. Stop at the first+-- failure. The caller receives receipts only if the entire phase succeeds.+executeCommandPlan ::+  (Process :> es) =>+  UTCTime ->+  CommandPlan ->+  Eff es (Either CommandExecutionError [CommandReceipt])+executeCommandPlan completedAt commandPlan = go [] commandPlan.commands+  where+    go = executeCommands completedAt (\_ _ _ -> pure ())++-- | Execute a command plan while exposing successful captured output to an+-- effectful callback. The executable uses this to preserve its historical+-- stdout behavior; library callers that only need receipts use+-- 'executeCommandPlan'.+executeCommandPlanWithOutput ::+  (Process :> es) =>+  UTCTime ->+  (PlannedCommand -> Text -> Text -> Eff es ()) ->+  CommandPlan ->+  Eff es (Either CommandExecutionError [CommandReceipt])+executeCommandPlanWithOutput completedAt onSuccess commandPlan =+  executeCommands completedAt onSuccess [] commandPlan.commands++executeCommands ::+  (Process :> es) =>+  UTCTime ->+  (PlannedCommand -> Text -> Text -> Eff es ()) ->+  [CommandReceipt] ->+  [PlannedCommand] ->+  Eff es (Either CommandExecutionError [CommandReceipt])+executeCommands completedAt onSuccess = go+  where+    go completed [] = pure (Right (reverse completed))+    go completed (planned : remaining) = case planned.disposition of+      CommandSkippedUnchanged -> go completed remaining+      CommandSkippedDisabled -> go completed remaining+      CommandWillRun -> case planned.operation of+        RunCommandOp {command, workDir, moduleName} -> do+          (processExit, stdout, stderr) <- runProcess "sh" ["-c", command] workDir+          case processExit of+            ExitSuccess -> do+              onSuccess planned stdout stderr+              let receipt =+                    CommandReceipt+                      { fingerprint = planned.fingerprint,+                        moduleName,+                        command,+                        workDir,+                        completedAt+                      }+              go (receipt : completed) remaining+            ExitFailure exitCode ->+              pure+                ( Left+                    CommandExecutionError+                      { command = planned,+                        exitCode,+                        stdout,+                        stderr+                      }+                )+        _ -> go completed remaining++-- | Produce the accepted receipt map for the plan's current declaration set.+-- Removed commands are dropped. Fresh successes replace old receipts;+-- unchanged or explicitly disabled declarations retain a matching old receipt.+finalizeCommandReceipts ::+  CommandPlan ->+  [CommandReceipt] ->+  Map CommandFingerprint CommandReceipt ->+  Map CommandFingerprint CommandReceipt+finalizeCommandReceipts commandPlan completed priorReceipts =+  Map.fromList (mapMaybe receiptFor commandPlan.commands)+  where+    completedByFingerprint = Map.fromList [(receipt.fingerprint, receipt) | receipt <- completed]++    receiptFor planned =+      case Map.lookup planned.fingerprint completedByFingerprint of+        Just receipt -> Just (planned.fingerprint, receipt)+        Nothing -> case planned.disposition of+          CommandWillRun -> Nothing+          CommandSkippedUnchanged -> retainPrior planned+          CommandSkippedDisabled -> retainPrior planned++    retainPrior planned =+      (planned.fingerprint,) <$> Map.lookup planned.fingerprint priorReceipts
src/Seihou/CLI/CommitMessage.hs view
@@ -88,6 +88,6 @@         _ -> txt  fallbackMessage :: [ModuleName] -> T.Text-fallbackMessage [] = "seihou: apply modules"-fallbackMessage [m] = "seihou: apply module " <> m.unModuleName-fallbackMessage ms = "seihou: apply modules " <> T.intercalate ", " (map (.unModuleName) ms)+fallbackMessage [] = "chore(seihou): apply modules"+fallbackMessage [m] = "chore(seihou): apply " <> m.unModuleName+fallbackMessage ms = "chore(seihou): apply " <> T.intercalate ", " (map (.unModuleName) ms)
src/Seihou/CLI/PendingMigrations.hs view
@@ -72,7 +72,10 @@   T.unlines $     "Pending migrations detected:"       : map renderEntry pendings-      ++ ["", "Run 'seihou migrate <module>' for each, or pass --with-migrations to apply during this run."]+      ++ [ "",+           "For a recorded project application, run 'seihou update <target>'.",+           "For focused recovery, run 'seihou migrate <module>' for each, or pass --with-migrations to this explicit reconfiguration run."+         ]   where     renderEntry (name, plan) =       "  "
src/Seihou/CLI/SchemaVersion.hs view
@@ -9,11 +9,11 @@  -- | Raw URL for the seihou-schema package.dhall at a pinned commit schemaUrl :: Text-schemaUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/a0fba0d17b43b14bfdf6d0bf98f1b7ff7af4ebab/package.dhall"+schemaUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/2dffa0592be47835a60784b89a289226ba990aa8/package.dhall"  -- | SHA256 integrity hash for the schema import schemaHash :: Text-schemaHash = "sha256:36250d32d50cec0ea8c74926684ffb8b20f6d0b4f2152930dfa04a1ff108ef3f"+schemaHash = "sha256:01b6f873520459f3958baa34d3f97a49a4263b9a7225a758cddca5ab3a911f61"  -- | Complete Dhall import line for use in generated modules schemaImportLine :: Text
src/Seihou/CLI/StatusRender.hs view
@@ -1,13 +1,15 @@ module Seihou.CLI.StatusRender   ( formatStatus,+    formatBlueprintMigrations,     ModuleAdvice (..),-    moduleAdvice,   ) where -import Data.List (intersperse)+import Data.List (intersperse, nub) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map+import Data.Maybe (isJust, listToMaybe, mapMaybe)+import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T import Data.Time.Format (defaultTimeLocale, formatTime)@@ -19,8 +21,12 @@ import Seihou.Core.Migration (MigrationPlan (..)) import Seihou.Core.Types   ( AppliedBlueprint (..),+    AppliedBlueprintMigration (..),+    AppliedComposition (..),+    AppliedInstanceState (..),     AppliedModule (..),     AppliedRecipe (..),+    AppliedTarget (..),     Manifest (..),     ModuleName (..),     ParentVars (..),@@ -31,41 +37,15 @@   ) import Seihou.Core.Version (renderVersion) --- | What action a single applied-module row recommends.------ Order of precedence: a pending migration always wins over a bare--- "outdated" annotation, because @seihou migrate@ (after EP-2) is--- self-contained and one command suffices to bring the project to the--- new version. An outdated row with no detected pending plan falls--- back to @seihou upgrade@.+-- | What action an applied module or recorded application recommends.+-- Pending migrations and ordinary version drift both route through the+-- project-aware update workflow. data ModuleAdvice-  = -- | Nothing pending; do not emit a hint.-    AdviceNone-  | -- | Module is outdated and no pending migration was detected. The-    -- renderer prints @"Run: seihou upgrade <name>"@.-    AdviceUpgradeOnly Text-  | -- | A pending migration was detected. The carried 'MigrationPlan'-    -- describes the version range and the in-window migrations that-    -- would run; 'planSteps' may be empty (a pure version bump) or-    -- non-empty. The renderer prints a one-line summary and-    -- @"Run: seihou migrate <name>"@.-    AdvicePendingMigration Text MigrationPlan+  = AdviceNone+  | AdviceProjectUpdate Text (Maybe MigrationPlan)+  | AdviceProjectUpdateAll   deriving stock (Eq, Show) --- | Decide which advice to emit for a single applied module. Any--- detected pending plan wins over a bare outdated annotation because--- @seihou migrate@ (after EP-2) is self-contained.-moduleAdvice ::-  AppliedModule ->-  Maybe OutdatedStatus ->-  Maybe MigrationPlan ->-  ModuleAdvice-moduleAdvice am mStatus mPlan = case mPlan of-  Just plan -> AdvicePendingMigration am.name.unModuleName plan-  Nothing -> case mStatus of-    Just OutdatedSt -> AdviceUpgradeOnly am.name.unModuleName-    _ -> AdviceNone- -- | Render the full @seihou status@ output as a single 'Text' value. -- -- @color@ controls ANSI styling; pass 'False' for plain text (used by@@ -82,6 +62,7 @@     ["Seihou Status:", ""]       ++ recipeSection manifest       ++ blueprintSection manifest+      ++ formatBlueprintMigrations manifest.blueprintMigrations       ++ appliedSection color manifest mEntries pendings       ++ trackedSection color tracked       ++ varsSection manifest@@ -93,19 +74,7 @@       Nothing -> Map.empty     pendingMap =       Map.fromList [(name.unModuleName, plan) | (name, plan) <- pendings]-    adviceList = map (rowAdvice entryMap pendingMap) manifest.modules---- | Build a 'ModuleAdvice' for one applied module from the lookup maps.-rowAdvice ::-  Map Text OutdatedEntry ->-  Map Text MigrationPlan ->-  AppliedModule ->-  ModuleAdvice-rowAdvice entryMap pendingMap am =-  let name = am.name.unModuleName-      mStatus = (.status) <$> Map.lookup name entryMap-      mPlan = Map.lookup name pendingMap-   in moduleAdvice am mStatus mPlan+    adviceList = projectAdviceList manifest entryMap pendingMap  -- --------------------------------------------------------------------------- -- Section renderers@@ -145,6 +114,27 @@           Just p -> ["  Prompt: \"" <> p <> "\""]      in [header, baselineLine] ++ promptLines ++ [""] +-- | Render durable agent-guided migration receipts. An empty ledger adds no+-- output; each populated row includes the artifact, exact edge, and timestamp.+formatBlueprintMigrations :: [AppliedBlueprintMigration] -> [Text]+formatBlueprintMigrations [] = []+formatBlueprintMigrations receipts =+  "Blueprint migrations:"+    : map renderReceipt receipts+      <> [""]+  where+    renderReceipt receipt =+      "  "+        <> receipt.name.unModuleName+        <> maybe "" (\version -> " v" <> version) receipt.blueprintVersion+        <> ": "+        <> receipt.fromVersion+        <> " -> "+        <> receipt.toVersion+        <> " (applied "+        <> T.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" receipt.appliedAt)+        <> ")"+ -- | Render the baseline body for the blueprint section. Three cases: -- @--no-baseline@ was passed, the blueprint declared no baseline at -- all, or one or more baseline modules were applied.@@ -173,16 +163,17 @@       Map.fromList [(name.unModuleName, plan) | (name, plan) <- pendings]     moduleLines       | null manifest.modules = ["  (none)"]-      | otherwise =-          concatMap-            ( \am ->-                let advice = rowAdvice entryMap pendingMap am-                    annotation = lookupEntry mEntries entryMap am-                    headerLine = formatModuleLine color annotation am-                    hintLines = formatAdvice color advice-                 in headerLine : hintLines-            )-            manifest.modules+      | otherwise = renderRows Set.empty manifest.modules+    renderRows _ [] = []+    renderRows seen (am : rest) =+      let name = am.name.unModuleName+          annotation = lookupEntry mEntries entryMap am+          headerLine = formatModuleLine color annotation am+          hintLines+            | Set.member name seen = []+            | null manifest.applications = formatAdvice color (rowProjectAdvice entryMap pendingMap am)+            | otherwise = maybe [] (formatPendingDetail color) (Map.lookup name pendingMap)+       in headerLine : hintLines <> renderRows (Set.insert name seen) rest  trackedSection :: Bool -> [TrackedFile] -> [Text] trackedSection color tracked =@@ -217,14 +208,14 @@ -- actionable problem. recommendedActionsSection :: [ModuleAdvice] -> [Text] recommendedActionsSection advices =-  case [c | Just c <- map adviceCommand advices] of+  case nub [c | Just c <- map adviceCommand advices] of     [] -> []     cmds -> ["", "Recommended actions:"] ++ map ("  " <>) cmds  adviceCommand :: ModuleAdvice -> Maybe Text adviceCommand AdviceNone = Nothing-adviceCommand (AdviceUpgradeOnly name) = Just ("seihou upgrade " <> name)-adviceCommand (AdvicePendingMigration name _) = Just ("seihou migrate " <> name)+adviceCommand (AdviceProjectUpdate target _) = Just ("seihou update " <> target)+adviceCommand AdviceProjectUpdateAll = Just "seihou update"  -- --------------------------------------------------------------------------- -- Per-row formatting@@ -287,23 +278,81 @@ -- under the module name. formatAdvice :: Bool -> ModuleAdvice -> [Text] formatAdvice _ AdviceNone = []-formatAdvice color (AdviceUpgradeOnly name) =-  ["    " <> applyColor color yellow ("Run: seihou upgrade " <> name)]-formatAdvice color (AdvicePendingMigration name plan) =-  ["    " <> applyColor color yellow (planSummary name plan)]+formatAdvice color (AdviceProjectUpdate target Nothing) =+  ["    " <> applyColor color yellow ("Run: seihou update " <> target)]+formatAdvice color (AdviceProjectUpdate target (Just plan)) =+  ["    " <> applyColor color yellow (projectPlanSummary target plan)]+formatAdvice color AdviceProjectUpdateAll =+  ["    " <> applyColor color yellow "Run: seihou update"] --- | Format the "Pending migration: from -> to (N step(s)). Run:--- seihou migrate <name>" line for a pending-migration advice row.-planSummary :: Text -> MigrationPlan -> Text-planSummary name plan =+projectPlanSummary :: Text -> MigrationPlan -> Text+projectPlanSummary target plan =   "Pending migration: "     <> renderVersion plan.planFrom     <> " -> "     <> renderVersion plan.planTo     <> " ("     <> T.pack (show (length plan.planSteps))-    <> " step(s)). Run: seihou migrate "-    <> name+    <> " step(s)). Run: seihou update "+    <> target++formatPendingDetail :: Bool -> MigrationPlan -> [Text]+formatPendingDetail color plan =+  [ "    "+      <> applyColor+        color+        yellow+        ( "Pending migration: "+            <> renderVersion plan.planFrom+            <> " -> "+            <> renderVersion plan.planTo+            <> " ("+            <> T.pack (show (length plan.planSteps))+            <> " step(s))"+        )+  ]++rowProjectAdvice ::+  Map Text OutdatedEntry ->+  Map Text MigrationPlan ->+  AppliedModule ->+  ModuleAdvice+rowProjectAdvice entryMap pendingMap applied =+  if actionable+    then AdviceProjectUpdate name pending+    else AdviceNone+  where+    name = applied.name.unModuleName+    pending = Map.lookup name pendingMap+    outdated = maybe False ((== OutdatedSt) . (.status)) (Map.lookup name entryMap)+    actionable = outdated || isJust pending++projectAdviceList ::+  Manifest ->+  Map Text OutdatedEntry ->+  Map Text MigrationPlan ->+  [ModuleAdvice]+projectAdviceList manifest entryMap pendingMap+  | null manifest.applications =+      map (rowProjectAdvice entryMap pendingMap) (deduplicateModules manifest.modules)+  | otherwise =+      let applicationAdvice = mapMaybe adviceForApplication manifest.applications+       in applicationAdvice <> [AdviceProjectUpdateAll | length applicationAdvice > 1]+  where+    adviceForApplication application =+      let names = map (.name.unModuleName) application.instances+          pending = listToMaybe (mapMaybe (`Map.lookup` pendingMap) names)+          outdated = any (maybe False ((== OutdatedSt) . (.status)) . (`Map.lookup` entryMap)) names+       in if outdated || isJust pending+            then Just (AdviceProjectUpdate (targetText application.target) pending)+            else Nothing++deduplicateModules :: [AppliedModule] -> [AppliedModule]+deduplicateModules = Map.elems . Map.fromList . map (\applied -> (applied.name.unModuleName, applied))++targetText :: AppliedTarget -> Text+targetText (AppliedModuleTarget name) = name.unModuleName+targetText (AppliedRecipeTarget name) = name.unRecipeName  renderEntry :: Bool -> OutdatedEntry -> Text renderEntry color e = case e.status of
src/Seihou/CLI/Style.hs view
@@ -87,8 +87,10 @@ renderNonFileColor :: PreviewLine -> Text renderNonFileColor (DirPreview path) =   "    " <> cyan "mkdir" <> "  " <> cyan (T.pack path)-renderNonFileColor (CommandPreview cmd) =-  "    " <> dim "run" <> "    " <> dim cmd+renderNonFileColor (CommandPreview cmd mOwner) =+  "    " <> dim "run" <> "    " <> dim cmd <> ownerSuffix mOwner+  where+    ownerSuffix = maybe "" (\owner -> "  " <> dim ("(" <> owner.unModuleName <> ")")) renderNonFileColor (OrphanPreview path modName') =   "    " <> magenta "[orphaned]" <> "  " <> magenta (T.pack path) <> "  " <> dim ("(orphaned from " <> modName'.unModuleName <> ")") renderNonFileColor _ = ""
+ src/Seihou/CLI/Update.hs view
@@ -0,0 +1,1068 @@+module Seihou.CLI.Update+  ( UpdateSelection (..),+    PromptPolicy (..),+    UpdateRequest (..),+    VersionChange (..),+    InputChangeSummary (..),+    CandidateArtifactKind (..),+    CandidateArtifact (..),+    PlannedUpdateMigration (..),+    UpdateWarning (..),+    UpdatePlan (..),+    CommandSummary (..),+    UpdateResult (..),+    UpdateError (..),+    planProjectUpdate,+    applyProjectUpdate,+    withProjectUpdate,+    isUpdateNoOp,+  )+where++import Control.Exception (SomeException, displayException, try)+import Control.Monad (foldM, forM, forM_, when)+import Data.Foldable (traverse_)+import Data.List (find, isPrefixOf)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, isJust, mapMaybe, maybeToList)+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 Effectful (runEff)+import Seihou.CLI.CommandExecution+import Seihou.CLI.InstallShared (installModuleDir)+import Seihou.CLI.Shared (deriveNamespace, toVarNameMap)+import Seihou.CLI.Update.Migrations+import Seihou.CLI.Update.Recovery+import Seihou.CLI.Update.Selection+import Seihou.CLI.Update.Source+import Seihou.CLI.Update.Types+import Seihou.Composition.Instance (ModuleInstance (..))+import Seihou.Composition.Plan (compileComposedPlan)+import Seihou.Composition.Recipe (expandRecipe)+import Seihou.Composition.Resolve+  ( PromptPermission (..),+    SavedInstanceValues,+    loadComposition,+    resolveWithPromptPermission,+  )+import Seihou.Core.Application (buildAppliedComposition, replaceAppliedComposition)+import Seihou.Core.Module (defaultSearchPaths, discoverRunnable)+import Seihou.Core.Types+import Seihou.Core.Version (parseVersion)+import Seihou.Effect.BaselineStore (pruneBaselines)+import Seihou.Effect.BaselineStoreInterp (runBaselineStore)+import Seihou.Effect.ConfigReader+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Effect.ConsoleInterp (runConsole)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.FilesystemPure (PureFS (..))+import Seihou.Effect.ManifestStore (readManifest, writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Effect.ProcessInterp (runProcessIO)+import Seihou.Engine.Baseline (manifestBaselineRefs)+import Seihou.Engine.Migrate (ExecutedMigrationPlan (..), MigrationOpInstance (..), classifyMigration, executeMigration)+import Seihou.Engine.Reconcile+import Seihou.Engine.UpdateTransaction+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types (currentManifestVersion)+import Seihou.Prelude+import System.Directory qualified as Directory+import System.Environment (getEnvironment)+import System.FilePath (takeDirectory)+import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory, withSystemTempDirectory)++-- | Lifetime-safe public planning entry point. Candidate clones exist for the+-- callback only, so an 'UpdatePlan' cannot accidentally outlive its sources.+withProjectUpdate ::+  UpdateRequest ->+  (Either UpdateError UpdatePlan -> IO a) ->+  IO a+withProjectUpdate request callback =+  withSystemTempDirectory "seihou-project-update" $ \sessionDirectory ->+    planProjectUpdateIn sessionDirectory request >>= callback++-- | Internal/test-facing planner. Prefer 'withProjectUpdate'; this form keeps+-- its temporary session until process exit or a test removes it.+planProjectUpdate :: UpdateRequest -> IO (Either UpdateError UpdatePlan)+planProjectUpdate request = do+  temporaryRoot <- getCanonicalTemporaryDirectory+  sessionDirectory <- createTempDirectory temporaryRoot "seihou-project-update"+  result <- planProjectUpdateIn sessionDirectory request+  case result of+    Left _ -> Directory.removePathForcibly sessionDirectory+    Right _ -> pure ()+  pure result++planProjectUpdateIn :: FilePath -> UpdateRequest -> IO (Either UpdateError UpdatePlan)+planProjectUpdateIn sessionDirectory request = do+  projectRoot <- Directory.getCurrentDirectory+  installedDirectory <- standardInstalledDirectory+  recovery <- recoverAtEntry projectRoot+  case recovery of+    Left err -> pure (Left err)+    Right () -> do+      let manifestPath = projectRoot </> ".seihou" </> "manifest.json"+          baselineDirectory = projectRoot </> ".seihou" </> "baselines"+      manifestResult <- readManifestIO manifestPath+      case manifestResult of+        Left err -> pure (Left err)+        Right manifest -> do+          now <- getCurrentTime+          seeded <- selectAndSeedLegacy request manifest now+          case seeded of+            Left err -> pure (Left err)+            Right (selected, seedWarnings) -> do+              staged <- stageCandidateSources sessionDirectory selected+              case staged of+                Left err -> pure (Left err)+                Right (catalog, sourceWarnings) -> do+                  plannedApplicationsResult <- traverse (planApplication request installedDirectory catalog now) selected+                  case sequence plannedApplicationsResult of+                    Left err -> pure (Left err)+                    Right plannedApplications -> do+                      let applicationInputs =+                            [ (Just previous, planned.modulesInOrder)+                            | (previous, planned) <- zip selected plannedApplications+                            ]+                      stagedMigrations <- planAndStageMigrations projectRoot manifest catalog applicationInputs+                      case stagedMigrations of+                        Left err -> pure (Left err)+                        Right migrationStage -> do+                          let (operations, owners, compositionWarnings) = combineApplicationPlans plannedApplications+                              selectedIds = Set.fromList (map (.candidate.applicationId) plannedApplications)+                          stageRoot <- materializeStagedProject sessionDirectory projectRoot migrationStage.filesystem operations+                          reconciliationResult <-+                            runEff $+                              runFilesystem $+                                runBaselineStore baselineDirectory $+                                  planReconciliation stageRoot migrationStage.manifest selectedIds operations owners+                          case reconciliationResult of+                            Left err -> pure (Left (UpdateReconciliationFailed err))+                            Right reconciliation -> do+                              evidence <- versionEvidence catalog selected plannedApplications+                              case evidence of+                                Left err -> pure (Left err)+                                Right (versionChanges, versionWarnings) -> do+                                  let usedArtifacts = artifactsUsedBy catalog plannedApplications+                                      priorReceipts = Map.unions (map (.commandReceipts) selected)+                                      commandPlan = planCommands request.commandPolicy priorReceipts operations+                                      warnings =+                                        seedWarnings+                                          <> sourceWarnings+                                          <> migrationStage.warnings+                                          <> compositionWarnings+                                          <> versionWarnings+                                      inputChanges = summarizeInputChanges seedWarnings plannedApplications+                                      transactionTargets = transactionTargetPaths manifest reconciliation migrationStage.plans+                                  observedProjectHashes <-+                                    observePaths+                                      projectRoot+                                      (Set.insert (".seihou" </> "manifest.json") transactionTargets)+                                  let snapshot =+                                        UpdateSnapshot+                                          { sessionDirectory,+                                            projectRoot,+                                            manifestPath,+                                            baselineDirectory,+                                            installedDirectory,+                                            originalManifest = manifest,+                                            candidateHashes = Map.fromList [(artifact.originalDirectory, artifact.contentHash) | artifact <- usedArtifacts],+                                            observedProjectHashes,+                                            transactionTargets+                                          }+                                  pure+                                    ( Right+                                        UpdatePlan+                                          { applications = map (.candidate) plannedApplications,+                                            versionChanges,+                                            inputChanges,+                                            migrations = migrationStage.plans,+                                            reconciliation,+                                            commandPlan,+                                            candidateArtifacts = usedArtifacts,+                                            warnings,+                                            request,+                                            snapshot,+                                            plannedApplications+                                          }+                                    )++applyProjectUpdate :: UpdatePlan -> IO (Either UpdateError UpdateResult)+applyProjectUpdate plan =+  Directory.withCurrentDirectory plan.snapshot.projectRoot $ do+    recovery <- recoverAtEntry plan.snapshot.projectRoot+    case recovery of+      Left err -> pure (Left err)+      Right () -> do+        stale <- stalePlanPaths plan+        if not (Set.null stale)+          then pure (Left (UpdatePlanStale stale))+          else+            if plan.request.dryRun+              then pure (Right (dryRunResult plan))+              else+                if not (Set.null (unresolvedPaths plan.reconciliation))+                  then pure (Left (UpdateHasUnresolvedPaths (unresolvedPaths plan.reconciliation)))+                  else+                    if isStructuredNoOp plan+                      then pure (Right (noOpResult plan))+                      else applyAcceptedPlan plan++applyAcceptedPlan :: UpdatePlan -> IO (Either UpdateError UpdateResult)+applyAcceptedPlan plan = do+  transactionResult <- beginUpdateTransaction plan.snapshot.projectRoot plan.snapshot.transactionTargets+  case transactionResult of+    Left err -> pure (Left (UpdateTransactionFailed err))+    Right transaction -> do+      backupResult <- prepareServiceBackups transaction plan.snapshot.installedDirectory plan.migrations plan.candidateArtifacts+      case backupResult of+        Left err -> abortUpdate transaction err+        Right () -> do+          now <- getCurrentTime+          migrated <- runRealMigrations now plan.snapshot.originalManifest plan.migrations+          case migrated of+            Left err -> abortUpdate transaction err+            Right migratedManifest -> do+              actualReconciliation <- planActualReconciliation plan migratedManifest+              case actualReconciliation of+                Left err -> abortUpdate transaction err+                Right actual -> case reapplyPlannedResolutions plan.reconciliation actual of+                  Left _ ->+                    abortUpdate+                      transaction+                      ( UpdateChangedAfterMigrationCommand+                          (reconciliationSummary plan.reconciliation)+                          (reconciliationSummary actual)+                      )+                  Right resolvedActual+                    | resolvedActual /= plan.reconciliation ->+                        abortUpdate+                          transaction+                          ( UpdateChangedAfterMigrationCommand+                              (reconciliationSummary plan.reconciliation)+                              (reconciliationSummary resolvedActual)+                          )+                    | otherwise -> do+                        let reconciliationManifest = migratedManifest {genAt = now}+                        appliedFiles <- applyReconciliation transaction resolvedActual reconciliationManifest+                        case appliedFiles of+                          Left err -> abortUpdate transaction (UpdateTransactionFailed err)+                          Right filesManifest -> do+                            commandResult <-+                              runEff $+                                runProcessIO $+                                  executeCommandPlan now plan.commandPlan+                            case commandResult of+                              Left err ->+                                abortUpdate+                                  transaction+                                  (UpdateCommandFailed err [ArbitraryCommandSideEffectsMayRemain])+                              Right completedReceipts -> do+                                let finalManifest = buildFinalManifest now plan filesManifest completedReceipts+                                markerResult <- setCommitMarkers transaction finalManifest+                                case markerResult of+                                  Left err -> abortUpdate transaction err+                                  Right () -> do+                                    publication <- publishCandidates plan.candidateArtifacts+                                    case publication of+                                      Left err -> abortUpdate transaction err+                                      Right () -> do+                                        written <- writeManifestIO plan.snapshot.manifestPath finalManifest+                                        case written of+                                          Left err -> abortUpdate transaction err+                                          Right () -> finishCommitted transaction plan finalManifest completedReceipts++planApplication ::+  UpdateRequest ->+  FilePath ->+  CandidateCatalog ->+  UTCTime ->+  AppliedComposition ->+  IO (Either UpdateError PlannedApplication)+planApplication request installedDirectory catalog now previous = do+  fallback <- defaultSearchPaths+  case candidateRoot catalog previous of+    Left err -> pure (Left err)+    Right (primary, recipeAdditional, recipeOverrides, targetArtifact) -> do+      let allAdditional = recipeAdditional <> previous.additionalModules+      loaded <- loadComposition (catalog.searchRoot : fallback) primary allAdditional+      case loaded of+        Left err -> pure (Left (CandidateLoadFailed primary.unModuleName err))+        Right modulesInOrder -> do+          let savedValues+                | request.reconfigure = Map.empty+                | otherwise = savedInstanceValues previous+              namespace = fromMaybe (deriveNamespace primary) previous.namespace+              context = fromMaybe "" previous.context+          resolved <- resolveApplicationValues request namespace context savedValues recipeOverrides modulesInOrder+          case resolved of+            Left err -> pure (Left err)+            Right resolvedValues -> do+              compiled <-+                compileComposedPlan+                  [ (instanceId, modul, directory, Map.map (.value) (resolvedValues Map.! instanceId))+                  | (instanceId, modul, directory) <- modulesInOrder+                  ]+              case compiled of+                Left errors -> pure (Left (UpdateCompositionFailed errors))+                Right (operations, compositionWarnings, rawOwners) -> do+                  let targetSource = publishedArtifactSource installedDirectory targetArtifact+                      candidate0 =+                        ( buildAppliedComposition+                            previous.target+                            targetSource+                            targetArtifact.version+                            previous.additionalModules+                            (Just namespace)+                            previous.context+                            modulesInOrder+                            resolvedValues+                            now+                        )+                          { applicationId = previous.applicationId+                          }+                      candidate =+                        setCompositionState+                          (map (publishInstanceSource installedDirectory catalog) candidate0.instances)+                          previous.commandReceipts+                          candidate0+                      desiredOwners =+                        Map.map+                          (\owner -> DesiredFileOwner owner (Set.singleton candidate.applicationId))+                          rawOwners+                      renderedWarnings = map compositionWarning compositionWarnings+                  pure+                    ( Right+                        PlannedApplication+                          { previous = Just previous,+                            candidate,+                            modulesInOrder,+                            resolvedValues,+                            operations,+                            desiredOwners+                          }+                    )+  where+    compositionWarning (FileOverwritten path old new) = CrossApplicationLastWriter path old new+    compositionWarning (ContentMerged path old new) = CrossApplicationLastWriter path old new++candidateRoot ::+  CandidateCatalog ->+  AppliedComposition ->+  Either UpdateError (ModuleName, [ModuleName], Map VarName Text, CandidateArtifact)+candidateRoot catalog previous = case previous.target of+  AppliedModuleTarget name -> do+    artifact <- lookupArtifact catalog CandidateModule name.unModuleName+    Right (name, [], Map.empty, artifact)+  AppliedRecipeTarget name -> do+    artifact <- lookupArtifact catalog CandidateRecipe name.unRecipeName+    recipe <- maybe (Left (CandidateArtifactMissing CandidateRecipe name.unRecipeName)) Right artifact.recipeDefinition+    (primary, additional, overrides, _, _) <- first (CandidateRepositoryInvalid name.unRecipeName) (expandRecipe recipe)+    Right (primary, additional, overrides, artifact)++lookupArtifact :: CandidateCatalog -> CandidateArtifactKind -> Text -> Either UpdateError CandidateArtifact+lookupArtifact catalog kind name =+  maybe (Left (CandidateArtifactMissing kind name)) Right (Map.lookup (kind, name) catalog.artifacts)++resolveApplicationValues ::+  UpdateRequest ->+  Text ->+  Text ->+  SavedInstanceValues ->+  Map VarName Text ->+  [(ModuleInstance, Module, FilePath)] ->+  IO (Either UpdateError (Map ModuleInstance (Map VarName ResolvedVar)))+resolveApplicationValues request namespace context saved recipeOverrides modulesInOrder = do+  envPairs <- getEnvironment+  configs <- loadConfigMaps namespace context+  case configs of+    Left err -> pure (Left err)+    Right (localConfig, namespaceConfig, contextConfig, globalConfig) -> do+      let cli = Map.fromList [(VarName name, value) | (name, value) <- request.varOverrides]+          overrides = Map.union cli recipeOverrides+          env = Map.fromList [(T.pack key, T.pack value) | (key, value) <- envPairs]+          promptPermission = case request.promptPolicy of+            AllowPrompts -> PromptsAllowed+            ForbidPrompts -> PromptsForbidden+      result <-+        runEff $+          runConsole $+            resolveWithPromptPermission+              promptPermission+              modulesInOrder+              saved+              overrides+              env+              namespace+              context+              localConfig+              namespaceConfig+              contextConfig+              globalConfig+      pure (first UpdateVariableErrors result)++loadConfigMaps :: Text -> Text -> IO (Either UpdateError (Map VarName Text, Map VarName Text, Map VarName Text, Map VarName Text))+loadConfigMaps namespace context =+  runEff $ runConfigReader $ do+    local <- readLocalConfig+    namespaceValues <- readNamespaceConfig namespace+    contextValues <- readContextConfig context+    global <- readGlobalConfig+    pure $ do+      local' <- configResult local+      namespace' <- configResult namespaceValues+      context' <- configResult contextValues+      global' <- configResult global+      Right (toVarNameMap local', toVarNameMap namespace', toVarNameMap context', toVarNameMap global')+  where+    configResult = first (UpdateConfigurationFailed . T.pack . show)++selectAndSeedLegacy ::+  UpdateRequest ->+  Manifest ->+  UTCTime ->+  IO (Either UpdateError ([AppliedComposition], [UpdateWarning]))+selectAndSeedLegacy request manifest now = case selectApplications request.selection manifest of+  Left err -> pure (Left err)+  Right (RecordedSelection selected) -> pure (Right (selected, []))+  Right (LegacySelection name) -> seedLegacyApplication request manifest now name++seedLegacyApplication ::+  UpdateRequest -> Manifest -> UTCTime -> Text -> IO (Either UpdateError ([AppliedComposition], [UpdateWarning]))+seedLegacyApplication request manifest now requested = do+  searchPaths <- defaultSearchPaths+  discovered <- discoverRunnable searchPaths (ModuleName requested)+  case discovered of+    Left err -> pure (Left (CandidateLoadFailed requested err))+    Right runnable -> do+      let root = case runnable of+            RunnableModule modul directory -> Right (AppliedModuleTarget modul.name, modul.name, [], Map.empty, directory, modul.version)+            RunnableRecipe recipe directory -> do+              (primary, additional, overrides, _, _) <- first (CandidateRepositoryInvalid requested) (expandRecipe recipe)+              Right (AppliedRecipeTarget recipe.name, primary, additional, overrides, directory, recipe.version)+            _ -> Left (CandidateArtifactMissing CandidateModule requested)+      case root of+        Left err -> pure (Left err)+        Right (target, primary, additional, recipeOverrides, targetSource, targetVersion) -> do+          loaded <- loadComposition searchPaths primary additional+          case loaded of+            Left err -> pure (Left (CandidateLoadFailed requested err))+            Right modulesInOrder -> do+              let (saved, warnings) = legacySavedValues manifest modulesInOrder+                  namespace = deriveNamespace primary+              resolved <- resolveApplicationValues request namespace "" saved recipeOverrides modulesInOrder+              case resolved of+                Left err -> pure (Left err)+                Right resolvedValues -> do+                  let provisional0 =+                        buildAppliedComposition target targetSource targetVersion [] (Just namespace) Nothing modulesInOrder resolvedValues now+                      provisional = provisional0 {instances = map (restoreLegacyVersion manifest) provisional0.instances}+                  pure (Right ([provisional], warnings))++legacySavedValues ::+  Manifest ->+  [(ModuleInstance, Module, FilePath)] ->+  (SavedInstanceValues, [UpdateWarning])+legacySavedValues manifest modulesInOrder = (saved, warnings)+  where+    declarations = [(instanceId, declaration) | (instanceId, modul, _) <- modulesInOrder, declaration <- modul.vars]+    counts = Map.fromListWith (+) [(declaration.name, 1 :: Int) | (_, declaration) <- declarations]+    saved =+      Map.fromListWith+        Map.union+        [ (instanceId, Map.singleton declaration.name value)+        | (instanceId, declaration) <- declarations,+          Map.lookup declaration.name counts == Just 1,+          Just value <- [Map.lookup declaration.name manifest.vars]+        ]+    ambiguous =+      [ AmbiguousLegacyValue name+      | (name, count) <- Map.toAscList counts,+        count > 1,+        Map.member name manifest.vars+      ]+    missing =+      [ MissingLegacyValue declaration.name+      | (_, declaration) <- declarations,+        declaration.required,+        Map.notMember declaration.name manifest.vars+      ]+    warnings = ambiguous <> missing++restoreLegacyVersion :: Manifest -> AppliedInstanceState -> AppliedInstanceState+restoreLegacyVersion manifest state =+  case find (\applied -> applied.name == state.name && applied.parentVars == state.parentVars) manifest.modules of+    Nothing -> state+    Just applied ->+      AppliedInstanceState+        { name = state.name,+          parentVars = state.parentVars,+          source = applied.source,+          moduleVersion = applied.moduleVersion,+          resolvedVars = state.resolvedVars+        }++savedInstanceValues :: AppliedComposition -> SavedInstanceValues+savedInstanceValues application =+  Map.fromList+    [ (ModuleInstance state.name state.parentVars, state.resolvedVars)+    | state <- application.instances+    ]++combineApplicationPlans ::+  [PlannedApplication] ->+  ([Operation], Map FilePath DesiredFileOwner, [UpdateWarning])+combineApplicationPlans = foldl' addApplication ([], Map.empty, [])+  where+    addApplication (operations, owners, warnings) application =+      let crossWarnings =+            [ CrossApplicationLastWriter path prior.moduleName next.moduleName+            | (path, next) <- Map.toAscList application.desiredOwners,+              Just prior <- [Map.lookup path owners],+              prior.moduleName /= next.moduleName+            ]+          mergedOwners = Map.unionWith mergeOwner application.desiredOwners owners+       in (operations <> application.operations, mergedOwners, warnings <> crossWarnings)+    mergeOwner newest prior =+      DesiredFileOwner newest.moduleName (Set.union newest.applicationIds prior.applicationIds)++materializeStagedProject :: FilePath -> FilePath -> PureFS -> [Operation] -> IO FilePath+materializeStagedProject sessionDirectory projectRoot filesystem operations = do+  let stageRoot = sessionDirectory </> "staged-project"+  Directory.createDirectoryIfMissing True stageRoot+  forM_ (Map.toAscList filesystem.files) $ \(path, content) -> writeStageFile stageRoot path content+  forM_ (Set.toAscList filesystem.dirs) $ \path -> Directory.createDirectoryIfMissing True (stageRoot </> path)+  forM_ (Set.toAscList (Set.fromList (mapMaybe operationDestination operations))) $ \path -> do+    stagedExists <- Directory.doesFileExist (stageRoot </> path)+    when (not stagedExists) $ do+      let projectPath = projectRoot </> path+      projectExists <- Directory.doesFileExist projectPath+      when projectExists (TIO.readFile projectPath >>= writeStageFile stageRoot path)+  pure stageRoot++writeStageFile :: FilePath -> FilePath -> Text -> IO ()+writeStageFile root path content = do+  Directory.createDirectoryIfMissing True (takeDirectory (root </> path))+  TIO.writeFile (root </> path) content++operationDestination :: Operation -> Maybe FilePath+operationDestination WriteFileOp {dest} = Just dest+operationDestination CopyFileOp {dest} = Just dest+operationDestination PatchFileOp {dest} = Just dest+operationDestination _ = Nothing++versionEvidence ::+  CandidateCatalog ->+  [AppliedComposition] ->+  [PlannedApplication] ->+  IO (Either UpdateError ([VersionChange], [UpdateWarning]))+versionEvidence catalog previousApplications plannedApplications = do+  evidence <- fmap concat $ sequence (zipWith applicationEvidence previousApplications plannedApplications)+  pure $ do+    changes <- sequence evidence+    let actualChanges = filter isActualChange changes+    traverse_ validateVersionChange actualChanges+    let unique = Map.elems (Map.fromList [(versionKey change, change) | change <- actualChanges])+        warnings =+          [ SameVersionContentChanged change.name+          | change <- unique,+            change.sameVersionContentChanged,+            isJust change.fromVersion+          ]+    Right (unique, warnings)+  where+    applicationEvidence previous planned = do+      instanceEvidence <- traverse (instanceVersionEvidence previous) planned.modulesInOrder+      targetEvidence <- targetVersionEvidence previous+      pure (targetEvidence : instanceEvidence)++    instanceVersionEvidence previous (instanceId, candidateModule, _) = do+      let prior = find (\state -> state.name == instanceId.instanceModule && state.parentVars == instanceId.instanceParentVars) previous.instances+      case prior of+        Nothing -> pure (Right (VersionChange candidateModule.name.unModuleName Nothing candidateModule.version False))+        Just old -> compareArtifact old.name.unModuleName old.moduleVersion candidateModule.version old.source CandidateModule++    targetVersionEvidence previous = case previous.target of+      AppliedModuleTarget _ -> pure (Right (VersionChange "" Nothing Nothing False))+      AppliedRecipeTarget name -> compareArtifact name.unRecipeName previous.targetVersion (candidateVersion CandidateRecipe name.unRecipeName) previous.targetSource CandidateRecipe++    candidateVersion kind name = (.version) =<< Map.lookup (kind, name) catalog.artifacts++    compareArtifact name fromVersion toVersion oldSource kind = do+      oldHashResult <- try @SomeException (hashArtifactDirectory oldSource)+      let candidateHash = (.contentHash) <$> Map.lookup (kind, name) catalog.artifacts+          changed = case (oldHashResult, candidateHash) of+            (Right oldHash, Just newHash) -> oldHash /= newHash+            _ -> True+      pure+        ( Right+            VersionChange+              { name,+                fromVersion,+                toVersion,+                sameVersionContentChanged = changed && fromVersion == toVersion+              }+        )++    versionKey change = (change.name, change.fromVersion, change.toVersion, change.sameVersionContentChanged)+    isActualChange change =+      not (T.null change.name)+        && (change.fromVersion /= change.toVersion || change.sameVersionContentChanged)++validateVersionChange :: VersionChange -> Either UpdateError ()+validateVersionChange change+  | T.null change.name = Right ()+  | otherwise = case (change.fromVersion, change.toVersion) of+      (Just fromText, Just toText) -> do+        fromVersion <- maybe (Left (CandidateVersionInvalid change.name fromText)) Right (parseVersion fromText)+        toVersion <- maybe (Left (CandidateVersionInvalid change.name toText)) Right (parseVersion toText)+        if toVersion < fromVersion+          then Left (CandidateDowngrade change.name change.fromVersion change.toVersion)+          else Right ()+      _ -> Right ()++artifactsUsedBy :: CandidateCatalog -> [PlannedApplication] -> [CandidateArtifact]+artifactsUsedBy catalog planned = Map.elems (Map.restrictKeys catalog.artifacts keys)+  where+    keys =+      Set.fromList $+        concatMap applicationKeys planned+    applicationKeys application =+      targetKey application.candidate.target+        : [(CandidateModule, modul.name.unModuleName) | (_, modul, _) <- application.modulesInOrder]+    targetKey (AppliedModuleTarget name) = (CandidateModule, name.unModuleName)+    targetKey (AppliedRecipeTarget name) = (CandidateRecipe, name.unRecipeName)++summarizeInputChanges :: [UpdateWarning] -> [PlannedApplication] -> InputChangeSummary+summarizeInputChanges seedWarnings planned =+  foldl' summarizeApplication emptySummary planned+  where+    emptySummary =+      InputChangeSummary+        { reused = 0,+          overridden = 0,+          newlyResolved = 0,+          removed = 0,+          ambiguousLegacy = [name | AmbiguousLegacyValue name <- seedWarnings]+        }+    summarizeApplication summary application =+      let prior = maybe Map.empty savedInstanceValues application.previous+          candidateValues = application.resolvedValues+          resolvedList =+            [ (instanceId, name, value)+            | (instanceId, values) <- Map.toList candidateValues,+              (name, value) <- Map.toList values+            ]+          reusedCount = length [() | (_, _, value) <- resolvedList, value.source == FromApplication]+          overriddenCount =+            length+              [ ()+              | (instanceId, name, value) <- resolvedList,+                value.source == FromCLI,+                Map.member name (Map.findWithDefault Map.empty instanceId prior)+              ]+          newCount =+            length+              [ ()+              | (instanceId, name, _) <- resolvedList,+                Map.notMember name (Map.findWithDefault Map.empty instanceId prior)+              ]+          removedCount =+            length+              [ ()+              | (instanceId, oldValues) <- Map.toList prior,+                name <- Map.keys oldValues,+                Map.notMember name (Map.findWithDefault Map.empty instanceId candidateValues)+              ]+       in summary+            { reused = summary.reused + reusedCount,+              overridden = summary.overridden + overriddenCount,+              newlyResolved = summary.newlyResolved + newCount,+              removed = summary.removed + removedCount+            }++transactionTargetPaths :: Manifest -> ReconciliationPlan -> [PlannedUpdateMigration] -> Set FilePath+transactionTargetPaths manifest reconciliation migrations =+  Map.keysSet reconciliation.files `Set.union` Set.fromList (concatMap migrationTargets migrations)+  where+    migrationTargets migration = concatMap targets migration.stagedPlan.planOps+    targets (MoveFileInst source destination _) = [source, destination]+    targets (DeleteFileInst path _) = [path]+    targets (MoveDirInst source destination) =+      concatMap (moveDirectoryTarget source destination) (Map.keys manifest.files)+    targets (DeleteDirInst path) = filter (isPathAtOrBelow path) (Map.keys manifest.files)+    targets RunCommandInst {} = []+    moveDirectoryTarget source destination path+      | isPathAtOrBelow source path = [path, replacePrefix source destination path]+      | isPathAtOrBelow destination path = [path]+      | otherwise = []++isPathAtOrBelow :: FilePath -> FilePath -> Bool+isPathAtOrBelow directory path = path == directory || (directory <> "/") `isPrefixOf` path++replacePrefix :: FilePath -> FilePath -> FilePath -> FilePath+replacePrefix source destination path+  | path == source = destination+  | otherwise = destination <> drop (length source) path++observePaths :: FilePath -> Set FilePath -> IO (Map FilePath (Maybe SHA256))+observePaths projectRoot paths =+  Map.fromList <$> traverse observe (Set.toAscList paths)+  where+    observe path = do+      let fullPath = projectRoot </> path+      exists <- Directory.doesFileExist fullPath+      hash <- if exists then Just . hashContent <$> TIO.readFile fullPath else pure Nothing+      pure (path, hash)++stalePlanPaths :: UpdatePlan -> IO (Set FilePath)+stalePlanPaths plan = do+  currentProject <-+    observePaths+      plan.snapshot.projectRoot+      (Map.keysSet plan.snapshot.observedProjectHashes)+  candidateChecks <- forM (Map.toAscList plan.snapshot.candidateHashes) $ \(path, expected) -> do+    current <- try @SomeException (hashArtifactDirectory path)+    pure $ case current of+      Right actual | actual == expected -> []+      _ -> [path]+  let projectChanges =+        Map.keysSet+          (Map.filterWithKey (\path observed -> Map.lookup path currentProject /= Just observed) plan.snapshot.observedProjectHashes)+  pure (Set.union projectChanges (Set.fromList (concat candidateChecks)))++planActualReconciliation :: UpdatePlan -> Manifest -> IO (Either UpdateError ReconciliationPlan)+planActualReconciliation plan manifest = do+  let (operations, owners, _) = combineApplicationPlans plan.plannedApplications+      selected = Set.fromList (map (.applicationId) plan.applications)+  result <-+    runEff $+      runFilesystem $+        runBaselineStore plan.snapshot.baselineDirectory $+          planReconciliation plan.snapshot.projectRoot manifest selected operations owners+  pure (first UpdateReconciliationFailed result)++-- | Reapply choices gathered after the initial read-only plan to the+-- reconciliation rebuilt after real migration commands. Exact equality is+-- still required afterward, so a command-induced classification or content+-- change remains a stale-plan failure rather than inheriting an old choice.+reapplyPlannedResolutions ::+  ReconciliationPlan ->+  ReconciliationPlan ->+  Either ReconciliationError ReconciliationPlan+reapplyPlannedResolutions planned actual =+  foldM reapplyOne actual (Map.toAscList planned.files)+  where+    reapplyOne actual (path, FileConflict _ _ _ _ _ _ (Just resolved)) =+      resolveFileConflict path resolved.choice actual+    reapplyOne actual (path, FileOrphanEdited _ _ _ _ (Just choice)) =+      resolveEditedOrphan path choice actual+    reapplyOne actual _ = Right actual++runRealMigrations :: UTCTime -> Manifest -> [PlannedUpdateMigration] -> IO (Either UpdateError Manifest)+runRealMigrations now manifest migrations =+  runEff $ runFilesystem $ runProcessIO $ go manifest migrations+  where+    go current [] = pure (Right current)+    go current (migration : rest) = do+      classified <- classifyMigration current migration.sourcePlan+      case classified of+        Left err -> pure (Left (UpdateMigrationFailed migration.moduleName err))+        Right executable -> do+          executed <- executeMigration False executable current now+          case executed of+            Left err -> pure (Left (UpdateMigrationFailed migration.moduleName err))+            Right next -> go next rest++buildFinalManifest :: UTCTime -> UpdatePlan -> Manifest -> [CommandReceipt] -> Manifest+buildFinalManifest now plan filesManifest completedReceipts =+  Manifest+    { version = currentManifestVersion,+      genAt = now,+      modules = updateAppliedModules filesManifest.modules filesManifest.applications plan.plannedApplications now,+      vars = Map.union candidateVars filesManifest.vars,+      files = filesManifest.files,+      applications = foldl' (flip replaceAppliedComposition) filesManifest.applications finalApplications,+      recipe = updatedRecipe,+      blueprint = filesManifest.blueprint,+      blueprintMigrations = filesManifest.blueprintMigrations+    }+  where+    finalApplications = map finalizeApplication plan.plannedApplications+    finalizeApplication application =+      let priorReceipts = maybe Map.empty (.commandReceipts) application.previous+          applicationPlan = planCommands plan.request.commandPolicy priorReceipts application.operations+          receipts = finalizeCommandReceipts applicationPlan completedReceipts priorReceipts+       in setCompositionState application.candidate.instances receipts application.candidate+    candidateVars =+      Map.unions+        [ Map.map (varValueToText . (.value)) values+        | application <- plan.plannedApplications,+          values <- Map.elems application.resolvedValues+        ]+    updatedRecipe =+      foldl' updateRecipe filesManifest.recipe finalApplications+    updateRecipe current application = case application.target of+      AppliedRecipeTarget name -> Just AppliedRecipe {name, recipeVersion = application.targetVersion, appliedAt = now}+      AppliedModuleTarget _ -> current++updateAppliedModules :: [AppliedModule] -> [AppliedComposition] -> [PlannedApplication] -> UTCTime -> [AppliedModule]+updateAppliedModules existing recordedApplications applications now =+  let modulesInOrder = concatMap (.modulesInOrder) applications+      candidateKeys = Set.fromList [(instanceId.instanceModule, instanceId.instanceParentVars) | (instanceId, _, _) <- modulesInOrder]+      selectedIds = Set.fromList (map (.candidate.applicationId) applications)+      priorSelectedKeys =+        Set.fromList+          [ (state.name, state.parentVars)+          | application <- applications,+            previous <- maybeToList application.previous,+            state <- previous.instances+          ]+      protectedKeys =+        Set.fromList+          [ (state.name, state.parentVars)+          | application <- recordedApplications,+            Set.notMember application.applicationId selectedIds,+            state <- application.instances+          ]+      replacedOrRemoved key =+        Set.member key candidateKeys+          || (Set.member key priorSelectedKeys && Set.notMember key protectedKeys)+      retained = filter (not . replacedOrRemoved . (\applied -> (applied.name, applied.parentVars))) existing+      updated =+        [ AppliedModule+            { name = instanceId.instanceModule,+              parentVars = instanceId.instanceParentVars,+              source = publishInstanceDirectory application instanceId,+              moduleVersion = modul.version,+              appliedAt = now,+              removal = modul.removal+            }+        | (application, instanceId, modul) <- deduplicateInstances applications+        ]+   in retained <> updated+  where+    deduplicateInstances = go Set.empty . concatMap expand+      where+        expand application =+          [ (application, instanceId, modul)+          | (instanceId, modul, _) <- application.modulesInOrder+          ]+        go _ [] = []+        go seen (entry@(_, instanceId, _) : rest)+          | Set.member key seen = go seen rest+          | otherwise = entry : go (Set.insert key seen) rest+          where+            key = (instanceId.instanceModule, instanceId.instanceParentVars)++    publishInstanceDirectory application instanceId =+      case find (\state -> state.name == instanceId.instanceModule && state.parentVars == instanceId.instanceParentVars) application.candidate.instances of+        Just state -> state.source+        Nothing -> error "candidate application lost a loaded module instance"++setCompositionState :: [AppliedInstanceState] -> Map CommandFingerprint CommandReceipt -> AppliedComposition -> AppliedComposition+setCompositionState instances receipts composition =+  AppliedComposition+    { applicationId = composition.applicationId,+      target = composition.target,+      targetSource = composition.targetSource,+      targetVersion = composition.targetVersion,+      additionalModules = composition.additionalModules,+      namespace = composition.namespace,+      context = composition.context,+      instances,+      commandReceipts = receipts,+      appliedAt = composition.appliedAt+    }++publishInstanceSource :: FilePath -> CandidateCatalog -> AppliedInstanceState -> AppliedInstanceState+publishInstanceSource installedDirectory catalog state =+  case Map.lookup (CandidateModule, state.name.unModuleName) catalog.artifacts of+    Nothing -> state+    Just artifact ->+      AppliedInstanceState+        { name = state.name,+          parentVars = state.parentVars,+          source = publishedArtifactSource installedDirectory artifact,+          moduleVersion = state.moduleVersion,+          resolvedVars = state.resolvedVars+        }++publishedArtifactSource :: FilePath -> CandidateArtifact -> FilePath+publishedArtifactSource installedDirectory artifact =+  if isJust artifact.sourceUrl+    then installedDirectory </> T.unpack artifact.name+    else artifact.originalDirectory++publishCandidates :: [CandidateArtifact] -> IO (Either UpdateError ())+publishCandidates artifacts = do+  result <- try @SomeException $+    forM_ artifacts $ \artifact -> case artifact.sourceUrl of+      Nothing -> pure ()+      Just sourceUrl ->+        installModuleDir+          artifact.originalDirectory+          (T.unpack artifact.name)+          sourceUrl+          artifact.repoName+          artifact.version+          artifact.tags+  pure $ first (UpdateCachePublicationFailed . T.pack . displayException) result++setCommitMarkers :: UpdateTransaction -> Manifest -> IO (Either UpdateError ())+setCommitMarkers transaction manifest = do+  core <- setUpdateTransactionExpectedManifest transaction manifest+  case core of+    Left err -> pure (Left (UpdateTransactionFailed err))+    Right () -> setServiceExpectedManifest transaction manifest++writeManifestIO :: FilePath -> Manifest -> IO (Either UpdateError ())+writeManifestIO path manifest = do+  result <- try @SomeException $ runEff $ runFilesystem $ runManifestStore path $ writeManifest manifest+  pure $ first (UpdateManifestWriteFailed . T.pack . displayException) result++readManifestIO :: FilePath -> IO (Either UpdateError Manifest)+readManifestIO path = do+  result <- try @SomeException $ runEff $ runFilesystem $ runManifestStore path readManifest+  pure $ case result of+    Left err -> Left (UpdateManifestUnreadable path (T.pack (displayException err)))+    Right (Left err) -> Left (UpdateManifestUnreadable path err)+    Right (Right Nothing) -> Left (UpdateManifestMissing path)+    Right (Right (Just manifest)) -> Right manifest++abortUpdate :: UpdateTransaction -> UpdateError -> IO (Either UpdateError a)+abortUpdate transaction original = do+  serviceRestore <- restoreServiceBackups transaction+  coreRestore <- rollbackUpdateTransaction transaction+  pure $ case (serviceRestore, coreRestore) of+    (Left restoreError, _) -> Left restoreError+    (_, Left restoreError) -> Left (UpdateTransactionFailed restoreError)+    _ -> Left original++finishCommitted ::+  UpdateTransaction ->+  UpdatePlan ->+  Manifest ->+  [CommandReceipt] ->+  IO (Either UpdateError UpdateResult)+finishCommitted transaction plan manifest completedReceipts = do+  completion <- completeUpdateTransaction transaction+  pruneResult <-+    try @SomeException $+      runEff $+        runFilesystem $+          runBaselineStore plan.snapshot.baselineDirectory $+            pruneBaselines (manifestBaselineRefs manifest)+  let cleanupWarnings = case completion of+        Left err -> [RecoveryCleanupDeferred (T.pack (show err))]+        Right () -> []+      pruneWarnings = case pruneResult of+        Left err -> [BaselinePruneFailed (T.pack (displayException err))]+        Right _ -> []+      summary = summarizeCommandPlan plan.commandPlan+      originalBaselineRefs = manifestBaselineRefs plan.snapshot.originalManifest+      finalBaselineRefs = manifestBaselineRefs manifest+      changedBaselineRefs =+        (originalBaselineRefs Set.\\ finalBaselineRefs)+          `Set.union` (finalBaselineRefs Set.\\ originalBaselineRefs)+      baselinePaths =+        Set.map+          (\ref -> ".seihou" </> "baselines" </> T.unpack ref.unBaselineRef.unSHA256)+          changedBaselineRefs+      touched =+        plan.snapshot.transactionTargets+          `Set.union` baselinePaths+          `Set.union` Set.singleton (".seihou" </> "manifest.json")+  pure+    ( Right+        UpdateResult+          { updatedApplications = map (.applicationId) plan.applications,+            manifest,+            versions = plan.versionChanges,+            fileSummary = reconciliationSummary plan.reconciliation,+            commandSummary =+              CommandSummary+                { executed = length completedReceipts,+                  skippedUnchanged = summary.skippedUnchanged,+                  skippedDisabled = summary.skippedDisabled+                },+            touchedPaths = touched,+            warnings = plan.warnings <> cleanupWarnings <> pruneWarnings+          }+    )++recoverAtEntry :: FilePath -> IO (Either UpdateError ())+recoverAtEntry projectRoot = do+  serviceResults <- recoverServiceBackups projectRoot+  case [err | Left err <- serviceResults] of+    firstFailure : _ -> pure (Left firstFailure)+    [] -> do+      coreResults <- recoverIncompleteTransactions projectRoot+      let failures = [err | Left err <- coreResults]+      pure $ if null failures then Right () else Left (UpdateRecoveryFailed failures)++standardInstalledDirectory :: IO FilePath+standardInstalledDirectory = do+  searchPaths <- defaultSearchPaths+  pure (last searchPaths)++dryRunResult :: UpdatePlan -> UpdateResult+dryRunResult plan =+  (noOpResult plan)+    { versions = plan.versionChanges,+      fileSummary = reconciliationSummary plan.reconciliation,+      commandSummary = commandSummaryForPlan plan.commandPlan,+      warnings = plan.warnings+    }++noOpResult :: UpdatePlan -> UpdateResult+noOpResult plan =+  UpdateResult+    { updatedApplications = [],+      manifest = plan.snapshot.originalManifest,+      versions = [],+      fileSummary = reconciliationSummary plan.reconciliation,+      commandSummary = CommandSummary 0 0 0,+      touchedPaths = Set.empty,+      warnings = plan.warnings+    }++commandSummaryForPlan :: CommandPlan -> CommandSummary+commandSummaryForPlan commandPlan =+  let summary = summarizeCommandPlan commandPlan+   in CommandSummary summary.willRun summary.skippedUnchanged summary.skippedDisabled++isUpdateNoOp :: UpdatePlan -> Bool+isUpdateNoOp plan =+  null plan.versionChanges+    && null plan.migrations+    && plan.inputChanges.overridden == 0+    && plan.inputChanges.newlyResolved == 0+    && plan.inputChanges.removed == 0+    && (summarizeCommandPlan plan.commandPlan).willRun == 0+    && all unchangedFile (Map.elems plan.reconciliation.files)+    && and (zipWith sameApplication (mapMaybe (.previous) plan.plannedApplications) plan.applications)+  where+    unchangedFile FileUnchanged {} = True+    unchangedFile _ = False+    sameApplication previous candidate =+      previous.target == candidate.target+        && previous.targetSource == candidate.targetSource+        && previous.targetVersion == candidate.targetVersion+        && previous.additionalModules == candidate.additionalModules+        && previous.namespace == candidate.namespace+        && previous.context == candidate.context+        && previous.instances == candidate.instances+        && previous.commandReceipts == candidate.commandReceipts++isStructuredNoOp :: UpdatePlan -> Bool+isStructuredNoOp = isUpdateNoOp++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)
+ src/Seihou/CLI/Update/Interaction.hs view
@@ -0,0 +1,170 @@+module Seihou.CLI.Update.Interaction+  ( InteractionMode (..),+    InteractionError (..),+    ResolutionDecision (..),+    applyResolutionDecisions,+    forceResolveUpdatePlan,+    resolveInteractively,+  )+where++import Control.Exception (IOException, try)+import Control.Monad (foldM)+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 Seihou.CLI.Update.Types (UpdatePlan (..))+import Seihou.Engine.Reconcile+  ( FileConflictChoice (..),+    FileReconciliation (..),+    OrphanChoice (..),+    ReconciliationError,+    ReconciliationPlan (..),+    ReconciliationReason (..),+    resolveEditedOrphan,+    resolveFileConflict,+    unresolvedPaths,+  )+import Seihou.Prelude+import System.IO (hFlush, isEOF, stderr, stdin)++data InteractionMode = Interactive | NonInteractive+  deriving stock (Eq, Show)++data InteractionError+  = InteractionRequired (Set FilePath)+  | InteractionAborted FilePath+  | InteractionResolutionFailed ReconciliationError+  | InteractionInputFailed Text+  deriving stock (Eq, Show)++data ResolutionDecision+  = ResolveFile FilePath FileConflictChoice+  | ResolveOrphan FilePath OrphanChoice+  deriving stock (Eq, Show)++applyResolutionDecisions ::+  [ResolutionDecision] ->+  UpdatePlan ->+  Either InteractionError UpdatePlan+applyResolutionDecisions decisions plan = do+  reconciliation <- foldM applyOne plan.reconciliation decisions+  pure plan {reconciliation}+  where+    applyOne current (ResolveFile path choice) =+      first InteractionResolutionFailed (resolveFileConflict path choice current)+    applyOne current (ResolveOrphan path choice) =+      first InteractionResolutionFailed (resolveEditedOrphan path choice current)++forceResolveUpdatePlan :: UpdatePlan -> Either InteractionError UpdatePlan+forceResolveUpdatePlan plan = applyResolutionDecisions decisions plan+  where+    decisions = concatMap forceOne (Map.toAscList plan.reconciliation.files)+    forceOne (path, FileConflict _ _ _ reason _ _ Nothing) = case reason of+      MergeDriverUnavailable _ -> []+      _ -> [ResolveFile path AcceptGenerated]+    forceOne (path, FileOrphanEdited _ _ _ _ Nothing) =+      [ResolveOrphan path RetainTrackedOrphan]+    forceOne _ = []++resolveInteractively ::+  InteractionMode ->+  UpdatePlan ->+  IO (Either InteractionError UpdatePlan)+resolveInteractively mode plan+  | Set.null remaining = pure (Right plan)+  | mode == NonInteractive = pure (Left (InteractionRequired remaining))+  | otherwise = go plan (Map.toAscList plan.reconciliation.files)+  where+    remaining = unresolvedPaths plan.reconciliation+    go current [] = pure (Right current)+    go current ((path, reconciliation) : rest) = case reconciliation of+      FileConflict _ currentText markers reason _ _ Nothing -> do+        decision <- promptConflict path currentText markers reason+        case decision of+          Left err -> pure (Left err)+          Right choice -> case applyResolutionDecisions [ResolveFile path choice] current of+            Left err -> pure (Left err)+            Right updated -> go updated rest+      FileOrphanEdited _ _ content _ Nothing -> do+        decision <- promptOrphan path content+        case decision of+          Left err -> pure (Left err)+          Right choice -> case applyResolutionDecisions [ResolveOrphan path choice] current of+            Left err -> pure (Left err)+            Right updated -> go updated rest+      _ -> go current rest++promptConflict ::+  FilePath ->+  Text ->+  Text ->+  ReconciliationReason ->+  IO (Either InteractionError FileConflictChoice)+promptConflict path current markers reason = do+  TIO.hPutStrLn stderr ("Conflict: " <> T.pack path <> " (" <> T.pack (show reason) <> ")")+  TIO.hPutStrLn stderr "  Labels: baseline = previous generated, current = project, generated = candidate"+  TIO.hPutStrLn stderr "  Diff3 preview:"+  TIO.hPutStrLn stderr (indentPreview (if T.null markers then current else markers))+  promptChoice path "Choose [g]enerated, [k]eep current, [m]arkers, [a]bort: " parse+  where+    parse "g" = Just AcceptGenerated+    parse "generated" = Just AcceptGenerated+    parse "k" = Just KeepCurrent+    parse "keep" = Just KeepCurrent+    parse "m" = Just WriteConflictMarkers+    parse "markers" = Just WriteConflictMarkers+    parse "a" = Nothing+    parse "abort" = Nothing+    parse _ = Nothing++promptOrphan :: FilePath -> Text -> IO (Either InteractionError OrphanChoice)+promptOrphan path content = do+  TIO.hPutStrLn stderr ("Edited orphan: " <> T.pack path)+  TIO.hPutStrLn stderr (indentPreview content)+  promptChoice path "Choose [d]elete, [r]etain tracked, [u]nmanage and keep, [a]bort: " parse+  where+    parse "d" = Just DeleteEditedOrphan+    parse "delete" = Just DeleteEditedOrphan+    parse "r" = Just RetainTrackedOrphan+    parse "retain" = Just RetainTrackedOrphan+    parse "u" = Just DetachAndKeepOrphan+    parse "unmanage" = Just DetachAndKeepOrphan+    parse "a" = Nothing+    parse "abort" = Nothing+    parse _ = Nothing++promptChoice ::+  FilePath ->+  Text ->+  (Text -> Maybe a) ->+  IO (Either InteractionError a)+promptChoice path prompt parse = loop+  where+    loop = do+      TIO.hPutStr stderr prompt+      hFlush stderr+      eofResult <- try @IOException isEOF+      case eofResult of+        Left err -> pure (Left (InteractionInputFailed (T.pack (show err))))+        Right True -> pure (Left (InteractionAborted path))+        Right False -> do+          inputResult <- try @IOException TIO.getLine+          case inputResult of+            Left err -> pure (Left (InteractionInputFailed (T.pack (show err))))+            Right input ->+              let normalized = T.toLower (T.strip input)+               in if normalized `elem` ["a", "abort"]+                    then pure (Left (InteractionAborted path))+                    else case parse normalized of+                      Just choice -> pure (Right choice)+                      _ -> do+                        TIO.hPutStrLn stderr "Invalid choice; enter one of the displayed letters or words."+                        loop++indentPreview :: Text -> Text+indentPreview content =+  let shownLines = take 80 (T.lines content)+      suffix = if length (T.lines content) > 80 then ["  ... preview truncated ..."] else []+   in T.unlines (map ("  " <>) shownLines <> suffix)
+ src/Seihou/CLI/Update/Migrations.hs view
@@ -0,0 +1,233 @@+module Seihou.CLI.Update.Migrations+  ( StagedMigrations (..),+    planAndStageMigrations,+    migrationTouchedPaths,+    migrationTouchesDirectories,+  )+where++import Control.Monad (guard)+import Data.List (find)+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Set qualified as Set+import Data.Text.IO qualified as TIO+import Effectful (runPureEff)+import Seihou.CLI.Update.Types+import Seihou.Composition.Instance (ModuleInstance (..))+import Seihou.Core.Migration (Migration (..), MigrationOp (..), MigrationPlan (..), planMigrationChain)+import Seihou.Core.Types+import Seihou.Core.Version (parseVersion)+import Seihou.Effect.FilesystemPure (PureFS (..), runFilesystemPure)+import Seihou.Effect.ProcessPure (ProcessMock (..), runProcessPure)+import Seihou.Engine.Migrate+  ( ExecutedMigrationPlan (..),+    MigrationOpInstance (..),+    classifyMigration,+    executeMigration,+  )+import Seihou.Prelude+import System.Directory qualified as Directory+import System.Exit (ExitCode (..))+import System.FilePath (takeDirectory)++data StagedMigrations = StagedMigrations+  { plans :: [PlannedUpdateMigration],+    manifest :: Manifest,+    filesystem :: PureFS,+    warnings :: [UpdateWarning]+  }+  deriving stock (Eq, Show)++data Transition = Transition+  { moduleName :: ModuleName,+    originUrl :: Maybe Text,+    fromVersion :: Text,+    toVersion :: Text,+    candidateModule :: Module,+    sourceDirectory :: FilePath+  }++-- | Deduplicate equal module transitions and simulate them against a complete+-- snapshot of tracked project text. Shell commands are mocked as successful+-- and retained as explicit warnings for the real apply/revalidation phase.+planAndStageMigrations ::+  FilePath ->+  Manifest ->+  CandidateCatalog ->+  [(Maybe AppliedComposition, [(ModuleInstance, Module, FilePath)])] ->+  IO (Either UpdateError StagedMigrations)+planAndStageMigrations projectRoot manifest catalog applications = do+  initialFilesystem <- snapshotTrackedFiles projectRoot manifest+  pure $ do+    transitions <- collectTransitions catalog applications+    planned <- traverse planTransition (deduplicateTransitions transitions)+    let processMocks = concatMap commandMocks planned+        ((stageResult, finalFilesystem)) =+          runPureEff $+            runFilesystemPure initialFilesystem $+              runProcessPure processMocks $+                stageAll manifest [] planned+    (finalManifest, stagedPlans) <- stageResult+    let warnings =+          [ MigrationCommandNotSimulated plannedMigration.moduleName command+          | plannedMigration <- stagedPlans,+            RunCommandInst command _ <- plannedMigration.stagedPlan.planOps+          ]+    Right+      StagedMigrations+        { plans = stagedPlans,+          manifest = finalManifest,+          filesystem = finalFilesystem,+          warnings+        }++stageAll manifest completed [] = pure (Right (manifest, reverse completed))+stageAll manifest completed ((transition, sourcePlan) : rest) = do+  classified <- classifyMigration manifest sourcePlan+  case classified of+    Left err -> pure (Left (UpdateMigrationStageFailed transition.moduleName err))+    Right stagedPlan -> do+      executed <- executeMigration False stagedPlan manifest manifest.genAt+      case executed of+        Left err -> pure (Left (UpdateMigrationStageFailed transition.moduleName err))+        Right nextManifest ->+          let planned =+                PlannedUpdateMigration+                  { moduleName = transition.moduleName,+                    sourceDirectory = transition.sourceDirectory,+                    sourcePlan,+                    stagedPlan,+                    containsCommands = any isCommand stagedPlan.planOps+                  }+           in stageAll nextManifest (planned : completed) rest+  where+    isCommand RunCommandInst {} = True+    isCommand _ = False++collectTransitions ::+  CandidateCatalog ->+  [(Maybe AppliedComposition, [(ModuleInstance, Module, FilePath)])] ->+  Either UpdateError [Transition]+collectTransitions catalog applications = do+  let raw = concatMap applicationTransitions applications+      priorByModule =+        Map.fromListWith+          Set.union+          [ ((transition.moduleName, transition.originUrl), Set.singleton transition.fromVersion)+          | transition <- raw+          ]+  case [ (name, Set.toAscList versions)+       | ((name, _), versions) <- Map.toAscList priorByModule,+         Set.size versions > 1+       ] of+    (name, versions) : _ -> Left (UpdateConflictingPriorVersions name versions)+    [] -> Right raw+  where+    applicationTransitions (Nothing, _) = []+    applicationTransitions (Just previous, candidates) =+      mapMaybe (transitionFor previous) candidates++    transitionFor previous (instanceId, candidateModule, sourceDirectory) = do+      prior <- find (matches instanceId) previous.instances+      fromVersion <- prior.moduleVersion+      toVersion <- candidateModule.version+      guard (fromVersion /= toVersion)+      let artifact = Map.lookup (CandidateModule, candidateModule.name.unModuleName) catalog.artifacts+      pure+        Transition+          { moduleName = candidateModule.name,+            originUrl = artifact >>= (.sourceUrl),+            fromVersion,+            toVersion,+            candidateModule,+            sourceDirectory+          }++    matches instanceId state =+      state.name == instanceId.instanceModule+        && state.parentVars == instanceId.instanceParentVars++deduplicateTransitions :: [Transition] -> [Transition]+deduplicateTransitions = go Set.empty+  where+    go _ [] = []+    go seen (transition : rest)+      | Set.member (transitionKey transition) seen = go seen rest+      | otherwise = transition : go (Set.insert (transitionKey transition) seen) rest++    transitionKey transition =+      ( transition.moduleName,+        transition.originUrl,+        transition.fromVersion,+        transition.toVersion+      )++planTransition :: Transition -> Either UpdateError (Transition, MigrationPlan)+planTransition transition = do+  fromVersion <-+    maybe+      (Left (CandidateVersionInvalid transition.moduleName.unModuleName transition.fromVersion))+      Right+      (parseVersion transition.fromVersion)+  toVersion <-+    maybe+      (Left (CandidateVersionInvalid transition.moduleName.unModuleName transition.toVersion))+      Right+      (parseVersion transition.toVersion)+  planned <-+    first+      (UpdateMigrationPlanFailed transition.moduleName)+      (planMigrationChain transition.moduleName.unModuleName transition.candidateModule.migrations fromVersion toVersion)+  case planned of+    Nothing -> error "planTransition received unequal versions but no migration plan"+    Just sourcePlan -> Right (transition, sourcePlan)++commandMocks :: (Transition, MigrationPlan) -> [ProcessMock]+commandMocks (_, sourcePlan) =+  [ ProcessMock+      { mockCommand = "/bin/sh",+        mockArgs = ["-c", command],+        mockResult = (ExitSuccess, "", "")+      }+  | migration <- sourcePlan.planSteps,+    RunCommand command _ <- migration.ops+  ]++snapshotTrackedFiles :: FilePath -> Manifest -> IO PureFS+snapshotTrackedFiles projectRoot manifest = do+  files <- fmap Map.fromList . fmap concat $ traverse readTracked (Map.keys manifest.files)+  let directories =+        Set.fromList+          [ directory+          | path <- Map.keys files,+            directory <- parents path+          ]+  pure PureFS {files, dirs = directories}+  where+    readTracked path = do+      let fullPath = projectRoot </> path+      exists <- Directory.doesFileExist fullPath+      if exists+        then do+          content <- TIO.readFile fullPath+          pure [(path, content)]+        else pure []++    parents path = takeWhile (\directory -> directory /= "." && directory /= "") (iterate takeDirectory (takeDirectory path))++migrationTouchedPaths :: [PlannedUpdateMigration] -> Set FilePath+migrationTouchedPaths = Set.fromList . concatMap (concatMap touched . (.stagedPlan.planOps))+  where+    touched (MoveFileInst source destination _) = [source, destination]+    touched (MoveDirInst source destination) = [source, destination]+    touched (DeleteFileInst path _) = [path]+    touched (DeleteDirInst path) = [path]+    touched RunCommandInst {} = []++migrationTouchesDirectories :: PlannedUpdateMigration -> Bool+migrationTouchesDirectories migration = any touchesDirectory migration.stagedPlan.planOps+  where+    touchesDirectory MoveDirInst {} = True+    touchesDirectory DeleteDirInst {} = True+    touchesDirectory _ = False
+ src/Seihou/CLI/Update/Recovery.hs view
@@ -0,0 +1,278 @@+module Seihou.CLI.Update.Recovery+  ( prepareServiceBackups,+    setServiceExpectedManifest,+    restoreServiceBackups,+    recoverServiceBackups,+  )+where++import Control.Exception (SomeException, displayException, try)+import Control.Monad (forM, forM_, unless, when)+import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LBS+import Data.List (isPrefixOf, sortOn)+import Data.Maybe (catMaybes, isJust)+import Data.Ord (Down (..))+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.CLI.Update.Types+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types+import Seihou.Engine.Migrate (ExecutedMigrationPlan (..), MigrationOpInstance (..))+import Seihou.Engine.UpdateTransaction (UpdateTransaction (..))+import Seihou.Manifest.Types (manifestFromJSON)+import Seihou.Prelude+import System.Directory qualified as Directory+import System.FilePath (splitDirectories, takeDirectory, takeFileName)++data BackupScope = ProjectDirectory | InstalledArtifact+  deriving stock (Eq, Show)++data ServiceBackup = ServiceBackup+  { scope :: BackupScope,+    target :: FilePath,+    backupName :: Maybe FilePath+  }+  deriving stock (Eq, Show)++data ServiceJournal = ServiceJournal+  { version :: Int,+    installedRoot :: FilePath,+    entries :: [ServiceBackup],+    expectedManifest :: Maybe Manifest+  }+  deriving stock (Eq, Show)++instance ToJSON BackupScope where+  toJSON ProjectDirectory = Aeson.String "project-directory"+  toJSON InstalledArtifact = Aeson.String "installed-artifact"++instance FromJSON BackupScope where+  parseJSON = Aeson.withText "BackupScope" $ \case+    "project-directory" -> pure ProjectDirectory+    "installed-artifact" -> pure InstalledArtifact+    other -> fail ("unknown backup scope: " <> T.unpack other)++instance ToJSON ServiceBackup where+  toJSON entry =+    Aeson.object+      [ "scope" .= entry.scope,+        "target" .= entry.target,+        "backup" .= entry.backupName+      ]++instance FromJSON ServiceBackup where+  parseJSON = Aeson.withObject "ServiceBackup" $ \object ->+    ServiceBackup <$> object .: "scope" <*> object .: "target" <*> object .:? "backup"++instance ToJSON ServiceJournal where+  toJSON journal =+    Aeson.object+      [ "version" .= journal.version,+        "installedRoot" .= journal.installedRoot,+        "entries" .= journal.entries,+        "expectedManifest" .= journal.expectedManifest+      ]++instance FromJSON ServiceJournal where+  parseJSON = Aeson.withObject "ServiceJournal" $ \object -> do+    version <- object .: "version"+    unless (version == (1 :: Int)) (fail "unsupported service journal version")+    ServiceJournal+      <$> pure version+      <*> object .: "installedRoot"+      <*> object .: "entries"+      <*> object .:? "expectedManifest"++-- | Persist byte-for-byte backups for whole migration directories and shared+-- cache destinations inside EP-66's transaction directory. The companion+-- recovery pass runs before EP-66 recovery and uses the same manifest commit+-- boundary.+prepareServiceBackups ::+  UpdateTransaction ->+  FilePath ->+  [PlannedUpdateMigration] ->+  [CandidateArtifact] ->+  IO (Either UpdateError ())+prepareServiceBackups transaction installedRoot migrations artifacts = do+  let projectDirectories = normalizeDirectories (concatMap migrationDirectories migrations)+      installedNames =+        Set.toAscList . Set.fromList $+          [ T.unpack artifact.name+          | artifact <- artifacts,+            isJust artifact.sourceUrl+          ]+      requests =+        map (ProjectDirectory,) projectDirectories+          <> map (InstalledArtifact,) installedNames+      backupRoot = transaction.transactionDirectory </> "service-backups"+  result <- try @SomeException $ do+    Directory.createDirectoryIfMissing True backupRoot+    entries <- forM (zip [0 :: Int ..] requests) $ \(index, (scope, target)) -> do+      fullTarget <- resolveTarget transaction.projectRoot installedRoot scope target+      exists <- Directory.doesDirectoryExist fullTarget+      if exists+        then do+          let backupName = show index+              backupPath = backupRoot </> backupName+          copyDirectoryBytes fullTarget backupPath+          pure ServiceBackup {scope, target, backupName = Just backupName}+        else pure ServiceBackup {scope, target, backupName = Nothing}+    writeServiceJournal+      transaction.transactionDirectory+      ServiceJournal+        { version = 1,+          installedRoot,+          entries,+          expectedManifest = Nothing+        }+  pure $ first (UpdateCachePublicationFailed . T.pack . displayException) result++setServiceExpectedManifest :: UpdateTransaction -> Manifest -> IO (Either UpdateError ())+setServiceExpectedManifest transaction expected = do+  current <- readServiceJournal transaction.transactionDirectory+  case current of+    Left err -> pure (Left err)+    Right Nothing -> pure (Right ())+    Right (Just journal) -> do+      result <-+        try @SomeException $+          writeServiceJournal+            transaction.transactionDirectory+            journal {expectedManifest = Just expected}+      pure $ first (UpdateManifestWriteFailed . T.pack . displayException) result++restoreServiceBackups :: UpdateTransaction -> IO (Either UpdateError ())+restoreServiceBackups transaction = do+  current <- readServiceJournal transaction.transactionDirectory+  case current of+    Left err -> pure (Left err)+    Right Nothing -> pure (Right ())+    Right (Just journal) -> restoreJournal transaction.projectRoot transaction.transactionDirectory journal++-- | Restore or accept every service journal before the core transaction+-- recovery pass. A durable matching manifest means cache/directory publication+-- committed; every other state restores the byte backups.+recoverServiceBackups :: FilePath -> IO [Either UpdateError ()]+recoverServiceBackups projectRoot = do+  let transactionsRoot = projectRoot </> ".seihou" </> "transactions"+  exists <- Directory.doesDirectoryExist transactionsRoot+  if not exists+    then pure []+    else do+      names <- Directory.listDirectory transactionsRoot+      fmap catMaybes . forM names $ \name -> do+        let transactionDirectory = transactionsRoot </> name+        isDirectory <- Directory.doesDirectoryExist transactionDirectory+        if not isDirectory+          then pure Nothing+          else do+            current <- readServiceJournal transactionDirectory+            case current of+              Left err -> pure (Just (Left err))+              Right Nothing -> pure Nothing+              Right (Just journal) -> do+                committed <- manifestMatches projectRoot journal.expectedManifest+                if committed+                  then pure (Just (Right ()))+                  else Just <$> restoreJournal projectRoot transactionDirectory journal++restoreJournal :: FilePath -> FilePath -> ServiceJournal -> IO (Either UpdateError ())+restoreJournal projectRoot transactionDirectory journal = do+  result <- try @SomeException $+    forM_ (sortOn (Down . pathDepth . (.target)) journal.entries) $ \entry -> do+      fullTarget <- resolveTarget projectRoot journal.installedRoot entry.scope entry.target+      targetExists <- Directory.doesPathExist fullTarget+      when targetExists (Directory.removePathForcibly fullTarget)+      case entry.backupName of+        Nothing -> pure ()+        Just backupName -> do+          validateBackupName backupName+          copyDirectoryBytes (transactionDirectory </> "service-backups" </> backupName) fullTarget+  pure $ first (UpdateCachePublicationFailed . T.pack . displayException) result++resolveTarget :: FilePath -> FilePath -> BackupScope -> FilePath -> IO FilePath+resolveTarget projectRoot _ ProjectDirectory target =+  case validateProjectRelativePath (T.pack target) of+    Left reason -> ioError (userError ("unsafe project backup path: " <> T.unpack reason))+    Right safe+      | safe == "." || targetsControlPath safe -> ioError (userError "unsafe project backup target")+      | otherwise -> pure (projectRoot </> safe)+resolveTarget _ installedRoot InstalledArtifact target+  | takeFileName target == target && target /= "." && target /= ".." = pure (installedRoot </> target)+  | otherwise = ioError (userError "unsafe installed artifact backup target")++validateBackupName :: FilePath -> IO ()+validateBackupName name+  | takeFileName name == name && name /= "." && name /= ".." = pure ()+  | otherwise = ioError (userError "unsafe service backup name")++targetsControlPath :: FilePath -> Bool+targetsControlPath path = case splitDirectories path of+  first : _ -> first == ".seihou" || first == ".git"+  [] -> False++migrationDirectories :: PlannedUpdateMigration -> [FilePath]+migrationDirectories migration = concatMap directories migration.stagedPlan.planOps+  where+    directories (MoveDirInst source destination) = [source, destination]+    directories (DeleteDirInst path) = [path]+    directories _ = []++normalizeDirectories :: [FilePath] -> [FilePath]+normalizeDirectories paths = filter notCovered sorted+  where+    sorted = sortOn pathDepth (Set.toAscList (Set.fromList paths))+    notCovered path = not (any (isParentOf path) sorted)+    isParentOf child parent =+      parent /= child+        && splitDirectories parent `isPrefixOf` splitDirectories child++pathDepth :: FilePath -> Int+pathDepth = length . splitDirectories++copyDirectoryBytes :: FilePath -> FilePath -> IO ()+copyDirectoryBytes source destination = do+  Directory.createDirectoryIfMissing True destination+  names <- Directory.listDirectory source+  forM_ names $ \name -> do+    let sourcePath = source </> name+        destinationPath = destination </> name+    isDirectory <- Directory.doesDirectoryExist sourcePath+    if isDirectory+      then copyDirectoryBytes sourcePath destinationPath+      else Directory.copyFile sourcePath destinationPath++writeServiceJournal :: FilePath -> ServiceJournal -> IO ()+writeServiceJournal transactionDirectory journal = do+  let path = serviceJournalPath transactionDirectory+      temporaryPath = path <> ".tmp"+  LBS.writeFile temporaryPath (Aeson.encode journal)+  Directory.renamePath temporaryPath path++readServiceJournal :: FilePath -> IO (Either UpdateError (Maybe ServiceJournal))+readServiceJournal transactionDirectory = do+  let path = serviceJournalPath transactionDirectory+  exists <- Directory.doesFileExist path+  if not exists+    then pure (Right Nothing)+    else do+      result <- try @SomeException (LBS.readFile path)+      pure $ case result of+        Left err -> Left (UpdateCachePublicationFailed (T.pack (displayException err)))+        Right bytes -> first (UpdateCachePublicationFailed . T.pack) (Just <$> Aeson.eitherDecode bytes)++serviceJournalPath :: FilePath -> FilePath+serviceJournalPath transactionDirectory = transactionDirectory </> "service-journal.json"++manifestMatches :: FilePath -> Maybe Manifest -> IO Bool+manifestMatches _ Nothing = pure False+manifestMatches projectRoot (Just expected) = do+  let path = projectRoot </> ".seihou" </> "manifest.json"+  exists <- Directory.doesFileExist path+  if not exists+    then pure False+    else do+      bytes <- LBS.readFile path+      pure (manifestFromJSON bytes == Right expected)
+ src/Seihou/CLI/Update/Render.hs view
@@ -0,0 +1,396 @@+module Seihou.CLI.Update.Render+  ( UpdateOutput (..),+    UpdatePlanView,+    UpdateResultView,+    UpdateErrorView,+    planOutput,+    resultOutput,+    errorOutput,+    renderUpdateHuman,+    encodeUpdateOutput,+  )+where++import Data.Aeson (Value, encode, object, (.=))+import Data.ByteString.Lazy (ByteString)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.CLI.CommandExecution+  ( CommandDisposition (..),+    CommandPlan (..),+    CommandPlanSummary (..),+    PlannedCommand (..),+    summarizeCommandPlan,+  )+import Seihou.CLI.Update.Types+import Seihou.Core.Migration (MigrationPlan (..))+import Seihou.Core.Types+  ( ApplicationId (..),+    AppliedComposition (..),+    AppliedTarget (..),+    BaselineRef (..),+    CommandFingerprint (..),+    ModuleName (..),+    Operation (..),+    RecipeName (..),+    SHA256 (..),+    VarName (..),+  )+import Seihou.Engine.Reconcile+  ( DesiredFile (..),+    FileConflictChoice (..),+    FileReconciliation (..),+    OrphanChoice (..),+    ReconciliationPlan (..),+    ReconciliationSummary (..),+    ResolvedFileConflict (..),+    reconciliationSummary,+  )+import Seihou.Prelude++newtype UpdatePlanView = UpdatePlanView UpdatePlan++newtype UpdateResultView = UpdateResultView UpdateResult++newtype UpdateErrorView = UpdateErrorView UpdateError++data UpdateOutput+  = UpdatePlanOutput UpdatePlanView+  | UpdateAppliedOutput UpdateResultView+  | UpdateFailedOutput UpdateErrorView++planOutput :: UpdatePlan -> UpdateOutput+planOutput = UpdatePlanOutput . UpdatePlanView++resultOutput :: UpdateResult -> UpdateOutput+resultOutput = UpdateAppliedOutput . UpdateResultView++errorOutput :: UpdateError -> UpdateOutput+errorOutput = UpdateFailedOutput . UpdateErrorView++renderUpdateHuman :: Bool -> UpdateOutput -> Text+renderUpdateHuman _ (UpdatePlanOutput (UpdatePlanView plan)) =+  T.unlines $+    versionLines plan+      <> [ renderInputs plan.inputChanges,+           "Migrations:  " <> count (length plan.migrations) <> migrationCaveat plan,+           renderFiles (reconciliationSummary plan.reconciliation),+           renderCommands (summarizeCommandPlan plan.commandPlan)+         ]+      <> conflictLines plan.reconciliation+      <> warningLines plan.warnings+renderUpdateHuman _ (UpdateAppliedOutput (UpdateResultView result)) =+  T.unlines $+    [ "Updated " <> count (length result.updatedApplications) <> " application(s).",+      renderFiles result.fileSummary,+      "Commands:    "+        <> count result.commandSummary.executed+        <> " executed; "+        <> count result.commandSummary.skippedUnchanged+        <> " unchanged skipped; "+        <> count result.commandSummary.skippedDisabled+        <> " disabled"+    ]+      <> warningLines result.warnings+renderUpdateHuman _ (UpdateFailedOutput (UpdateErrorView err)) =+  "Update failed [" <> errorCode err <> "]: " <> errorMessage err <> "\n"++encodeUpdateOutput :: UpdateOutput -> ByteString+encodeUpdateOutput = encode . outputValue++outputValue :: UpdateOutput -> Value+outputValue (UpdatePlanOutput (UpdatePlanView plan)) =+  object+    [ "schemaVersion" .= (1 :: Int),+      "outcome" .= ("plan" :: Text),+      "alreadyUpToDate" .= planLooksUnchanged plan,+      "applications" .= map applicationIdText plan.applications,+      "versions" .= map versionValue plan.versionChanges,+      "inputs" .= inputValue plan.inputChanges,+      "migrations" .= map migrationValue plan.migrations,+      "files" .= map fileValue (Map.toAscList plan.reconciliation.files),+      "commands" .= map commandValue plan.commandPlan.commands,+      "warnings" .= map warningText plan.warnings+    ]+outputValue (UpdateAppliedOutput (UpdateResultView result)) =+  object+    [ "schemaVersion" .= (1 :: Int),+      "outcome" .= ("applied" :: Text),+      "applications" .= map (.unApplicationId) result.updatedApplications,+      "versions" .= map versionValue result.versions,+      "files" .= summaryValue result.fileSummary,+      "commands"+        .= object+          [ "executed" .= result.commandSummary.executed,+            "skippedUnchanged" .= result.commandSummary.skippedUnchanged,+            "skippedDisabled" .= result.commandSummary.skippedDisabled+          ],+      "touchedPaths" .= Set.toAscList result.touchedPaths,+      "warnings" .= map warningText result.warnings+    ]+outputValue (UpdateFailedOutput (UpdateErrorView err)) =+  object+    [ "schemaVersion" .= (1 :: Int),+      "outcome" .= ("error" :: Text),+      "error" .= object ["code" .= errorCode err, "message" .= errorMessage err]+    ]++versionLines :: UpdatePlan -> [Text]+versionLines plan+  | null plan.versionChanges = ["Versions:    unchanged"]+  | otherwise = map renderVersionChange plan.versionChanges++renderVersionChange :: VersionChange -> Text+renderVersionChange change =+  change.name+    <> "  "+    <> fromMaybe "unversioned" change.fromVersion+    <> " -> "+    <> fromMaybe "unversioned" change.toVersion+    <> if change.sameVersionContentChanged then " (content changed at same version)" else ""++renderInputs :: InputChangeSummary -> Text+renderInputs summary =+  "Inputs:      "+    <> count summary.reused+    <> " reused; "+    <> count summary.overridden+    <> " overridden; "+    <> count summary.newlyResolved+    <> " newly resolved; "+    <> count summary.removed+    <> " removed"++renderFiles :: ReconciliationSummary -> Text+renderFiles summary =+  "Files:       "+    <> count summary.creates+    <> " created; "+    <> count summary.updates+    <> " updated; "+    <> count summary.merged+    <> " merged; "+    <> count summary.unchanged+    <> " unchanged; "+    <> count summary.conflicts+    <> " conflicts; "+    <> count summary.safeDeletes+    <> " deleted; "+    <> count summary.editedOrphans+    <> " edited orphans"++renderCommands summary =+  "Commands:    "+    <> count summary.willRun+    <> " will run; "+    <> count summary.skippedUnchanged+    <> " unchanged skipped; "+    <> count summary.skippedDisabled+    <> " disabled"++migrationCaveat plan+  | any (.containsCommands) plan.migrations = " (includes non-simulatable commands)"+  | otherwise = ""++conflictLines :: ReconciliationPlan -> [Text]+conflictLines reconciliation = concatMap renderOne (Map.toAscList reconciliation.files)+  where+    renderOne (path, FileConflict _ _ _ reason _ _ resolution) =+      [ "Conflict:    "+          <> T.pack path+          <> " ("+          <> T.pack (show reason)+          <> maybe "; unresolved" (("; " <>) . resolutionText . (.choice)) resolution+          <> ")"+      ]+    renderOne (path, FileOrphanEdited _ _ _ _ choice) =+      [ "Orphan:      "+          <> T.pack path+          <> maybe " (unresolved)" ((" (" <>) . (<> ")") . orphanChoiceText) choice+      ]+    renderOne _ = []++warningLines :: [UpdateWarning] -> [Text]+warningLines = map (("Warning:     " <>) . warningText)++versionValue :: VersionChange -> Value+versionValue change =+  object+    [ "name" .= change.name,+      "from" .= change.fromVersion,+      "to" .= change.toVersion,+      "sameVersionContentChanged" .= change.sameVersionContentChanged+    ]++inputValue :: InputChangeSummary -> Value+inputValue summary =+  object+    [ "reused" .= summary.reused,+      "overridden" .= summary.overridden,+      "newlyResolved" .= summary.newlyResolved,+      "removed" .= summary.removed,+      "ambiguousLegacy" .= map (.unVarName) summary.ambiguousLegacy+    ]++migrationValue :: PlannedUpdateMigration -> Value+migrationValue migration =+  object+    [ "module" .= migration.moduleName.unModuleName,+      "from" .= showText migration.sourcePlan.planFrom,+      "to" .= showText migration.sourcePlan.planTo,+      "steps" .= length migration.sourcePlan.planSteps,+      "containsCommands" .= migration.containsCommands+    ]++fileValue :: (FilePath, FileReconciliation) -> Value+fileValue (path, reconciliation) =+  object+    [ "path" .= path,+      "classification" .= classification reconciliation,+      "resolution" .= resolutionFor reconciliation+    ]++classification :: FileReconciliation -> Text+classification FileCreate {} = "create"+classification FileUpdate {} = "update"+classification FileAutoMerge {} = "autoMerge"+classification FileUnchanged {} = "unchanged"+classification FileConflict {} = "conflict"+classification FileDeleteSafe {} = "safeDelete"+classification FileOrphanEdited {} = "editedOrphan"+classification FileReleaseSharedOwnership {} = "releaseSharedOwnership"+classification FileAlreadyAbsent {} = "alreadyAbsent"++resolutionFor :: FileReconciliation -> Maybe Text+resolutionFor (FileConflict _ _ _ _ _ _ resolution) = resolutionText . (.choice) <$> resolution+resolutionFor (FileOrphanEdited _ _ _ _ choice) = orphanChoiceText <$> choice+resolutionFor _ = Nothing++commandValue :: PlannedCommand -> Value+commandValue planned =+  object+    [ "fingerprint" .= fingerprintText planned.fingerprint,+      "status" .= dispositionText planned.disposition,+      "module" .= commandModule planned.operation,+      "command" .= commandText planned.operation+    ]++commandModule :: Operation -> Maybe Text+commandModule RunCommandOp {moduleName} = Just moduleName.unModuleName+commandModule _ = Nothing++commandText :: Operation -> Maybe Text+commandText RunCommandOp {command} = Just command+commandText _ = Nothing++dispositionText :: CommandDisposition -> Text+dispositionText CommandWillRun = "willRun"+dispositionText CommandSkippedUnchanged = "skippedUnchanged"+dispositionText CommandSkippedDisabled = "skippedDisabled"++resolutionText :: FileConflictChoice -> Text+resolutionText AcceptGenerated = "useGenerated"+resolutionText KeepCurrent = "keepCurrent"+resolutionText WriteConflictMarkers = "writeConflictMarkers"+resolutionText AbortUpdate = "abort"++orphanChoiceText :: OrphanChoice -> Text+orphanChoiceText DeleteEditedOrphan = "delete"+orphanChoiceText RetainTrackedOrphan = "retainTracked"+orphanChoiceText DetachAndKeepOrphan = "detachAndKeep"+orphanChoiceText AbortOrphanUpdate = "abort"++summaryValue :: ReconciliationSummary -> Value+summaryValue summary =+  object+    [ "created" .= summary.creates,+      "updated" .= summary.updates,+      "merged" .= summary.merged,+      "unchanged" .= summary.unchanged,+      "conflicts" .= summary.conflicts,+      "safeDeletes" .= summary.safeDeletes,+      "editedOrphans" .= summary.editedOrphans,+      "sharedOwnership" .= summary.sharedOwnership+    ]++applicationIdText :: AppliedComposition -> Text+applicationIdText application = application.applicationId.unApplicationId++fingerprintText :: CommandFingerprint -> Text+fingerprintText (CommandFingerprint (SHA256 value)) = value++warningText :: UpdateWarning -> Text+warningText = T.pack . show++errorCode :: UpdateError -> Text+errorCode UpdateManifestMissing {} = "manifest_missing"+errorCode UpdateManifestUnreadable {} = "manifest_unreadable"+errorCode NoRecordedApplications = "no_recorded_applications"+errorCode LegacyUpdateRequiresOneTarget = "legacy_update_requires_one_target"+errorCode UpdateTargetNotFound {} = "target_not_found"+errorCode SharedPathRequiresApplications {} = "shared_path_requires_applications"+errorCode CandidateCloneFailed {} = "candidate_clone_failed"+errorCode CandidateRepositoryInvalid {} = "candidate_repository_invalid"+errorCode CandidateArtifactMissing {} = "candidate_artifact_missing"+errorCode CandidateArtifactAmbiguous {} = "candidate_artifact_ambiguous"+errorCode CandidateLoadFailed {} = "candidate_load_failed"+errorCode CandidateDowngrade {} = "candidate_downgrade"+errorCode CandidateVersionInvalid {} = "candidate_version_invalid"+errorCode UpdateConflictingPriorVersions {} = "conflicting_prior_versions"+errorCode UpdateVariableErrors {} = "variable_errors"+errorCode UpdateConfigurationFailed {} = "configuration_failed"+errorCode UpdateMigrationPlanFailed {} = "migration_plan_failed"+errorCode UpdateMigrationStageFailed {} = "migration_stage_failed"+errorCode UpdateCompositionFailed {} = "composition_failed"+errorCode UpdateReconciliationFailed {} = "reconciliation_failed"+errorCode UpdateHasUnresolvedPaths {} = "unresolved_paths"+errorCode UpdateRecoveryFailed {} = "recovery_failed"+errorCode UpdatePlanStale {} = "plan_stale"+errorCode UpdateTransactionFailed {} = "transaction_failed"+errorCode UpdateMigrationFailed {} = "migration_failed"+errorCode UpdateChangedAfterMigrationCommand {} = "changed_after_migration_command"+errorCode UpdateCommandFailed {} = "command_failed"+errorCode UpdateCachePublicationFailed {} = "cache_publication_failed"+errorCode UpdateManifestWriteFailed {} = "manifest_write_failed"++errorMessage :: UpdateError -> Text+errorMessage (UpdateManifestMissing path) =+  "No Seihou manifest was found at " <> T.pack path <> ". Run seihou run first."+errorMessage (UpdateTargetNotFound target available) =+  "No recorded application matches '"+    <> target+    <> "'. Available targets: "+    <> T.intercalate ", " available+errorMessage (SharedPathRequiresApplications path selected required) =+  "Path "+    <> T.pack path+    <> " is also owned by application(s) "+    <> T.intercalate ", " (map (.unApplicationId) (Set.toAscList required))+    <> ". Select every owner or run seihou update with no targets. Selected: "+    <> T.intercalate ", " (map (.unApplicationId) (Set.toAscList selected))+errorMessage (UpdateHasUnresolvedPaths paths) =+  "Resolve these paths before apply: " <> T.intercalate ", " (map T.pack (Set.toAscList paths))+errorMessage (UpdatePlanStale paths) =+  "The project changed after planning: " <> T.intercalate ", " (map T.pack (Set.toAscList paths))+errorMessage err = T.pack (show err)++planLooksUnchanged :: UpdatePlan -> Bool+planLooksUnchanged plan =+  null plan.versionChanges+    && null plan.migrations+    && plan.inputChanges.overridden == 0+    && plan.inputChanges.newlyResolved == 0+    && plan.inputChanges.removed == 0+    && (summarizeCommandPlan plan.commandPlan).willRun == 0+    && all isUnchanged (Map.elems plan.reconciliation.files)+  where+    isUnchanged FileUnchanged {} = True+    isUnchanged _ = False++count :: Int -> Text+count = T.pack . show++showText :: (Show a) => a -> Text+showText = T.pack . show
+ src/Seihou/CLI/Update/Selection.hs view
@@ -0,0 +1,85 @@+module Seihou.CLI.Update.Selection+  ( SelectedApplications (..),+    selectApplications,+    targetName,+    availableTargets,+  )+where++import Control.Monad (foldM)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Seihou.CLI.Update.Types+import Seihou.Core.Types+import Seihou.Prelude++data SelectedApplications+  = RecordedSelection [AppliedComposition]+  | LegacySelection Text+  deriving stock (Eq, Show)++-- | Select applications in manifest order. Bare module names select every+-- recorded application containing that module instance; target names take+-- precedence for each requested name.+selectApplications :: UpdateSelection -> Manifest -> Either UpdateError SelectedApplications+selectApplications selection manifest = case selection of+  AllRecordedApplications+    | null manifest.applications -> Left NoRecordedApplications+    | otherwise -> Right (RecordedSelection manifest.applications)+  NamedUpdateTargets names+    | null manifest.applications -> case nubOrd names of+        [name] -> Right (LegacySelection name)+        _ -> Left LegacyUpdateRequiresOneTarget+    | otherwise -> do+        selectedIds <- foldM selectName Set.empty (nubOrd names)+        let selected = filter ((`Set.member` selectedIds) . (.applicationId)) manifest.applications+        ensureOwnershipClosure manifest selectedIds+        Right (RecordedSelection selected)+  where+    selectName selected name =+      let exact = filter ((== name) . targetName) manifest.applications+          matches =+            if null exact+              then filter (containsModule name) manifest.applications+              else exact+       in if null matches+            then Left (UpdateTargetNotFound name (availableTargets manifest))+            else Right (foldl' (flip (Set.insert . (.applicationId))) selected matches)++ensureOwnershipClosure :: Manifest -> Set ApplicationId -> Either UpdateError ()+ensureOwnershipClosure manifest selected =+  case [ (path, selectedOwners, missingOwners)+       | (path, record) <- Map.toAscList manifest.files,+         let selectedOwners = Set.intersection selected record.applicationIds,+         let missingOwners = record.applicationIds Set.\\ selected,+         not (Set.null selectedOwners),+         not (Set.null missingOwners)+       ] of+    (path, selectedOwners, missingOwners) : _ ->+      Left (SharedPathRequiresApplications path selectedOwners missingOwners)+    [] -> Right ()++targetName :: AppliedComposition -> Text+targetName application = case application.target of+  AppliedModuleTarget name -> name.unModuleName+  AppliedRecipeTarget name -> name.unRecipeName++availableTargets :: Manifest -> [Text]+availableTargets manifest = nubOrd (map targetName manifest.applications <> instanceNames)+  where+    instanceNames =+      [ state.name.unModuleName+      | application <- manifest.applications,+        state <- application.instances+      ]++containsModule :: Text -> AppliedComposition -> Bool+containsModule name = any ((== name) . (.name.unModuleName)) . (.instances)++nubOrd :: (Ord a) => [a] -> [a]+nubOrd = go Set.empty+  where+    go _ [] = []+    go seen (value : rest)+      | Set.member value seen = go seen rest+      | otherwise = value : go (Set.insert value seen) rest
+ src/Seihou/CLI/Update/Source.hs view
@@ -0,0 +1,360 @@+module Seihou.CLI.Update.Source+  ( stageCandidateSources,+    hashArtifactDirectory,+  )+where++import Control.Exception (SomeException, displayException, try)+import Control.Monad (foldM, forM)+import Data.ByteString qualified as BS+import Data.Foldable (traverse_)+import Data.List (sort)+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.CLI.InstallShared+  ( OriginInfo (..),+    cloneRepo,+    copyDirectoryRecursive,+    readOriginInfo,+  )+import Seihou.CLI.Update.Types+import Seihou.Core.Module (validateModule)+import Seihou.Core.Recipe (validateRecipe)+import Seihou.Core.Registry (Registry (..), RegistryEntry (..), validateRegistry)+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalModuleFromFile, evalRecipeFromFile, evalRegistryFromFile)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Prelude+import System.Directory qualified as Directory+import System.Exit (ExitCode (..))+import System.Process (readProcessWithExitCode)++data ArtifactRequirement = ArtifactRequirement+  { kind :: CandidateArtifactKind,+    name :: Text,+    sourceDirectory :: FilePath,+    origin :: Maybe OriginInfo+  }++-- | Clone every distinct remote once, validate its complete module/recipe+-- catalog, and materialize a name-keyed temporary search root. Local artifacts+-- remain a fallback and are called out explicitly.+stageCandidateSources ::+  FilePath ->+  [AppliedComposition] ->+  IO (Either UpdateError (CandidateCatalog, [UpdateWarning]))+stageCandidateSources sessionRoot selected = do+  requirements <- requirementsFor selected+  let remoteOrigins =+        Map.fromList+          [ (origin.sourceUrl, origin)+          | requirement <- requirements,+            Just origin <- [requirement.origin]+          ]+      clonesRoot = sessionRoot </> "clones"+      searchRoot = sessionRoot </> "search"+  Directory.createDirectoryIfMissing True clonesRoot+  Directory.createDirectoryIfMissing True searchRoot+  remoteResult <- stageRemoteOrigins clonesRoot searchRoot (Map.toAscList remoteOrigins)+  case remoteResult of+    Left err -> pure (Left err)+    Right (remoteArtifacts, clones) -> do+      localResult <- stageLocalRequirements searchRoot remoteArtifacts requirements+      pure $ do+        (allArtifacts, localWarnings) <- localResult+        verifyRemoteRequirements requirements allArtifacts+        Right+          ( CandidateCatalog+              { searchRoot,+                artifacts = allArtifacts,+                clonedOrigins = clones+              },+            localWarnings+          )++requirementsFor :: [AppliedComposition] -> IO [ArtifactRequirement]+requirementsFor applications = concat <$> mapM applicationRequirements applications+  where+    applicationRequirements application = do+      targetOrigin <- readOriginInfo application.targetSource+      instanceRequirements <- forM application.instances $ \state -> do+        origin <- readOriginInfo state.source+        pure+          ArtifactRequirement+            { kind = CandidateModule,+              name = state.name.unModuleName,+              sourceDirectory = state.source,+              origin+            }+      let targetRequirement = case application.target of+            AppliedModuleTarget name ->+              ArtifactRequirement CandidateModule name.unModuleName application.targetSource targetOrigin+            AppliedRecipeTarget name ->+              ArtifactRequirement CandidateRecipe name.unRecipeName application.targetSource targetOrigin+      pure (targetRequirement : instanceRequirements)++stageRemoteOrigins ::+  FilePath ->+  FilePath ->+  [(Text, OriginInfo)] ->+  IO+    ( Either+        UpdateError+        (Map (CandidateArtifactKind, Text) CandidateArtifact, Map Text FilePath)+    )+stageRemoteOrigins clonesRoot searchRoot = go 0 Map.empty Map.empty+  where+    go _ artifacts clones [] = pure (Right (artifacts, clones))+    go index artifacts clones ((url, origin) : rest) = do+      let cloneDirectory = clonesRoot </> show index+      cloneResult <- cloneRepo url cloneDirectory+      case cloneResult of+        Left message -> pure (Left (CandidateCloneFailed url message))+        Right () -> do+          revision <- gitRevision cloneDirectory+          discovered <- discoverRemote url origin revision cloneDirectory+          case discovered of+            Left err -> pure (Left err)+            Right candidates -> do+              inserted <- foldM (insertCandidate searchRoot) (Right artifacts) candidates+              case inserted of+                Left err -> pure (Left err)+                Right artifacts' ->+                  go (index + 1) artifacts' (Map.insert url cloneDirectory clones) rest++discoverRemote ::+  Text ->+  OriginInfo ->+  Maybe Text ->+  FilePath ->+  IO (Either UpdateError [CandidateArtifact])+discoverRemote url origin revision repoRoot = do+  let registryFile = repoRoot </> "seihou-registry.dhall"+  hasRegistry <- Directory.doesFileExist registryFile+  if hasRegistry+    then do+      decoded <- evalRegistryFromFile registryFile+      case decoded of+        Left err -> pure (Left (CandidateLoadFailed (T.pack registryFile) err))+        Right registry -> do+          validationErrors <- validateRegistry repoRoot registry+          if null validationErrors+            then discoverRegistryArtifacts url revision repoRoot registry+            else pure (Left (CandidateRepositoryInvalid url validationErrors))+    else discoverSingleArtifact url origin revision repoRoot++discoverRegistryArtifacts ::+  Text ->+  Maybe Text ->+  FilePath ->+  Registry ->+  IO (Either UpdateError [CandidateArtifact])+discoverRegistryArtifacts url revision repoRoot registry = do+  modules <- traverse (loadRemoteModule url (Just registry.repoName) revision repoRoot) registry.modules+  recipes <- traverse (loadRemoteRecipe url (Just registry.repoName) revision repoRoot) registry.recipes+  pure ((<>) <$> sequence modules <*> sequence recipes)++discoverSingleArtifact ::+  Text ->+  OriginInfo ->+  Maybe Text ->+  FilePath ->+  IO (Either UpdateError [CandidateArtifact])+discoverSingleArtifact url origin revision repoRoot = do+  hasModule <- Directory.doesFileExist (repoRoot </> "module.dhall")+  hasRecipe <- Directory.doesFileExist (repoRoot </> "recipe.dhall")+  if hasModule+    then fmap (fmap (: [])) (loadModuleArtifact (Just url) origin.repoName [] revision repoRoot)+    else+      if hasRecipe+        then fmap (fmap (: [])) (loadRecipeArtifact (Just url) origin.repoName [] revision repoRoot)+        else pure (Left (CandidateRepositoryInvalid url ["repository contains no module, recipe, or registry"]))++loadRemoteModule ::+  Text -> Maybe Text -> Maybe Text -> FilePath -> RegistryEntry -> IO (Either UpdateError CandidateArtifact)+loadRemoteModule url repoName revision repoRoot entry =+  loadModuleArtifact (Just url) repoName entry.tags revision (repoRoot </> entry.path)++loadRemoteRecipe ::+  Text -> Maybe Text -> Maybe Text -> FilePath -> RegistryEntry -> IO (Either UpdateError CandidateArtifact)+loadRemoteRecipe url repoName revision repoRoot entry =+  loadRecipeArtifact (Just url) repoName entry.tags revision (repoRoot </> entry.path)++loadModuleArtifact ::+  Maybe Text -> Maybe Text -> [Text] -> Maybe Text -> FilePath -> IO (Either UpdateError CandidateArtifact)+loadModuleArtifact sourceUrl repoName tags revision directory = do+  decoded <- evalModuleFromFile (directory </> "module.dhall")+  case decoded of+    Left err -> pure (Left (CandidateLoadFailed (T.pack directory) err))+    Right modul -> do+      validated <- validateModule directory modul+      case validated of+        Left err -> pure (Left (CandidateLoadFailed modul.name.unModuleName err))+        Right candidateModule -> do+          contentHash <- hashArtifactDirectory directory+          pure+            ( Right+                CandidateArtifact+                  { kind = CandidateModule,+                    name = candidateModule.name.unModuleName,+                    version = candidateModule.version,+                    originalDirectory = directory,+                    sourceDirectory = directory,+                    sourceUrl,+                    repoName,+                    tags,+                    sourceRevision = revision,+                    contentHash,+                    moduleDefinition = Just candidateModule,+                    recipeDefinition = Nothing+                  }+            )++loadRecipeArtifact ::+  Maybe Text -> Maybe Text -> [Text] -> Maybe Text -> FilePath -> IO (Either UpdateError CandidateArtifact)+loadRecipeArtifact sourceUrl repoName tags revision directory = do+  decoded <- evalRecipeFromFile (directory </> "recipe.dhall")+  case first (CandidateLoadFailed (T.pack directory)) decoded of+    Left err -> pure (Left err)+    Right recipe -> case first (CandidateRepositoryInvalid (maybe "local" id sourceUrl)) (validateRecipe recipe) of+      Left err -> pure (Left err)+      Right validated -> do+        contentHash <- hashArtifactDirectory directory+        pure+          ( Right+              CandidateArtifact+                { kind = CandidateRecipe,+                  name = validated.name.unRecipeName,+                  version = validated.version,+                  originalDirectory = directory,+                  sourceDirectory = directory,+                  sourceUrl,+                  repoName,+                  tags,+                  sourceRevision = revision,+                  contentHash,+                  moduleDefinition = Nothing,+                  recipeDefinition = Just validated+                }+          )++stageLocalRequirements ::+  FilePath ->+  Map (CandidateArtifactKind, Text) CandidateArtifact ->+  [ArtifactRequirement] ->+  IO (Either UpdateError (Map (CandidateArtifactKind, Text) CandidateArtifact, [UpdateWarning]))+stageLocalRequirements searchRoot initial = go initial []+  where+    go artifacts warnings [] = pure (Right (artifacts, reverse warnings))+    go artifacts warnings (requirement : rest) = case requirement.origin of+      Just _ -> go artifacts warnings rest+      Nothing+        | Map.member (requirement.kind, requirement.name) artifacts -> go artifacts warnings rest+        | otherwise -> do+            loaded <- case requirement.kind of+              CandidateModule -> loadModuleArtifact Nothing Nothing [] Nothing requirement.sourceDirectory+              CandidateRecipe -> loadRecipeArtifact Nothing Nothing [] Nothing requirement.sourceDirectory+            case loaded of+              Left err -> pure (Left err)+              Right candidate -> do+                inserted <- insertCandidate searchRoot (Right artifacts) candidate+                case inserted of+                  Left err -> pure (Left err)+                  Right artifacts' ->+                    go artifacts' (LocalArtifactHasNoRemote requirement.name : warnings) rest++insertCandidate ::+  FilePath ->+  Either UpdateError (Map (CandidateArtifactKind, Text) CandidateArtifact) ->+  CandidateArtifact ->+  IO (Either UpdateError (Map (CandidateArtifactKind, Text) CandidateArtifact))+insertCandidate _ (Left err) _ = pure (Left err)+insertCandidate searchRoot (Right artifacts) candidate =+  case Map.lookup key artifacts of+    Just existing ->+      pure+        ( Left+            ( CandidateArtifactAmbiguous+                candidate.kind+                candidate.name+                (map (maybe "local" id . (.sourceUrl)) [existing, candidate])+            )+        )+    Nothing -> do+      let destination = searchRoot </> T.unpack candidate.name+      Directory.createDirectoryIfMissing True destination+      copied <- try @SomeException (copyDirectoryRecursive candidate.sourceDirectory destination)+      pure $ case copied of+        Left err -> Left (CandidateRepositoryInvalid candidate.name [T.pack (displayException err)])+        Right () ->+          Right+            ( Map.insert+                key+                (setCandidateSource destination candidate)+                artifacts+            )+  where+    key = (candidate.kind, candidate.name)++setCandidateSource :: FilePath -> CandidateArtifact -> CandidateArtifact+setCandidateSource directory candidate =+  CandidateArtifact+    { kind = candidate.kind,+      name = candidate.name,+      version = candidate.version,+      originalDirectory = candidate.originalDirectory,+      sourceDirectory = directory,+      sourceUrl = candidate.sourceUrl,+      repoName = candidate.repoName,+      tags = candidate.tags,+      sourceRevision = candidate.sourceRevision,+      contentHash = candidate.contentHash,+      moduleDefinition = candidate.moduleDefinition,+      recipeDefinition = candidate.recipeDefinition+    }++verifyRemoteRequirements ::+  [ArtifactRequirement] ->+  Map (CandidateArtifactKind, Text) CandidateArtifact ->+  Either UpdateError ()+verifyRemoteRequirements requirements artifacts = traverse_ verify requirements+  where+    verify requirement = case Map.lookup (requirement.kind, requirement.name) artifacts of+      Nothing -> Left (CandidateArtifactMissing requirement.kind requirement.name)+      Just candidate -> case requirement.origin of+        Nothing -> Right ()+        Just origin+          | candidate.sourceUrl == Just origin.sourceUrl -> Right ()+          | otherwise -> Left (CandidateArtifactMissing requirement.kind requirement.name)++gitRevision :: FilePath -> IO (Maybe Text)+gitRevision directory = do+  result <- try @SomeException (readProcessWithExitCode "git" ["-C", directory, "rev-parse", "HEAD"] "")+  pure $ case result of+    Right (ExitSuccess, stdout, _) -> Just (T.strip (T.pack stdout))+    _ -> Nothing++hashArtifactDirectory :: FilePath -> IO SHA256+hashArtifactDirectory root = do+  entries <- collectFiles root ""+  chunks <- forM entries $ \relative -> do+    bytes <- BS.readFile (root </> relative)+    pure (T.pack relative <> "\NUL" <> T.pack (show bytes))+  pure (hashContent (T.intercalate "\NUL" chunks))+  where+    collectFiles base relative = do+      let directory = if null relative then base else base </> relative+      names <- sort <$> Directory.listDirectory directory+      fmap concat $ forM names $ \name -> do+        let childRelative = if null relative then name else relative </> name+            child = base </> childRelative+        isDirectory <- Directory.doesDirectoryExist child+        if name == ".seihou-origin.json"+          then pure []+          else+            if isDirectory+              then+                if name == ".git"+                  then pure []+                  else collectFiles base childRelative+              else pure [childRelative]
+ src/Seihou/CLI/Update/Types.hs view
@@ -0,0 +1,215 @@+module Seihou.CLI.Update.Types+  ( UpdateSelection (..),+    PromptPolicy (..),+    UpdateRequest (..),+    VersionChange (..),+    InputChangeSummary (..),+    CandidateArtifactKind (..),+    CandidateArtifact (..),+    CandidateCatalog (..),+    PlannedUpdateMigration (..),+    PlannedApplication (..),+    UpdateSnapshot (..),+    UpdateWarning (..),+    UpdatePlan (..),+    CommandSummary (..),+    UpdateResult (..),+    UpdateError (..),+  )+where++import Data.Map.Strict (Map)+import Data.Set (Set)+import Seihou.CLI.CommandExecution+  ( CommandExecutionError,+    CommandPlan,+    CommandPolicy,+  )+import Seihou.Composition.Instance (ModuleInstance)+import Seihou.Core.Migration (MigrationPlan, MigrationPlanError)+import Seihou.Core.Types+import Seihou.Engine.Migrate (ExecutedMigrationPlan, MigrationExecError)+import Seihou.Engine.Reconcile+  ( DesiredFileOwner,+    ReconciliationError,+    ReconciliationPlan,+    ReconciliationSummary,+  )+import Seihou.Engine.UpdateTransaction (TransactionError)+import Seihou.Prelude++data UpdateSelection+  = AllRecordedApplications+  | NamedUpdateTargets [Text]+  deriving stock (Eq, Show)++data PromptPolicy+  = AllowPrompts+  | ForbidPrompts+  deriving stock (Eq, Show)++data UpdateRequest = UpdateRequest+  { selection :: UpdateSelection,+    varOverrides :: [(Text, Text)],+    reconfigure :: Bool,+    promptPolicy :: PromptPolicy,+    commandPolicy :: CommandPolicy,+    dryRun :: Bool+  }+  deriving stock (Eq, Show)++data VersionChange = VersionChange+  { name :: Text,+    fromVersion :: Maybe Text,+    toVersion :: Maybe Text,+    sameVersionContentChanged :: Bool+  }+  deriving stock (Eq, Show)++data InputChangeSummary = InputChangeSummary+  { reused :: Int,+    overridden :: Int,+    newlyResolved :: Int,+    removed :: Int,+    ambiguousLegacy :: [VarName]+  }+  deriving stock (Eq, Show)++data CandidateArtifactKind = CandidateModule | CandidateRecipe+  deriving stock (Eq, Ord, Show)++-- | One validated artifact staged for this update session. The source path is+-- temporary for remote candidates and must not escape 'withProjectUpdate'.+data CandidateArtifact = CandidateArtifact+  { kind :: CandidateArtifactKind,+    name :: Text,+    version :: Maybe Text,+    originalDirectory :: FilePath,+    sourceDirectory :: FilePath,+    sourceUrl :: Maybe Text,+    repoName :: Maybe Text,+    tags :: [Text],+    sourceRevision :: Maybe Text,+    contentHash :: SHA256,+    moduleDefinition :: Maybe Module,+    recipeDefinition :: Maybe Recipe+  }+  deriving stock (Eq, Show)++data CandidateCatalog = CandidateCatalog+  { searchRoot :: FilePath,+    artifacts :: Map (CandidateArtifactKind, Text) CandidateArtifact,+    clonedOrigins :: Map Text FilePath+  }+  deriving stock (Eq, Show)++data PlannedUpdateMigration = PlannedUpdateMigration+  { moduleName :: ModuleName,+    sourceDirectory :: FilePath,+    sourcePlan :: MigrationPlan,+    stagedPlan :: ExecutedMigrationPlan,+    containsCommands :: Bool+  }+  deriving stock (Eq, Show)++-- | Internal, renderer-neutral material retained so apply can re-plan after+-- migration commands without reusing parser state.+data PlannedApplication = PlannedApplication+  { previous :: Maybe AppliedComposition,+    candidate :: AppliedComposition,+    modulesInOrder :: [(ModuleInstance, Module, FilePath)],+    resolvedValues :: Map ModuleInstance (Map VarName ResolvedVar),+    operations :: [Operation],+    desiredOwners :: Map FilePath DesiredFileOwner+  }+  deriving stock (Eq, Show)++data UpdateSnapshot = UpdateSnapshot+  { sessionDirectory :: FilePath,+    projectRoot :: FilePath,+    manifestPath :: FilePath,+    baselineDirectory :: FilePath,+    installedDirectory :: FilePath,+    originalManifest :: Manifest,+    candidateHashes :: Map FilePath SHA256,+    observedProjectHashes :: Map FilePath (Maybe SHA256),+    transactionTargets :: Set FilePath+  }+  deriving stock (Eq, Show)++data UpdateWarning+  = LocalArtifactHasNoRemote Text+  | SameVersionContentChanged Text+  | AmbiguousLegacyValue VarName+  | MissingLegacyValue VarName+  | MigrationCommandNotSimulated ModuleName Text+  | CrossApplicationLastWriter FilePath ModuleName ModuleName+  | ArbitraryCommandSideEffectsMayRemain+  | BaselinePruneFailed Text+  | RecoveryCleanupDeferred Text+  deriving stock (Eq, Show)++data UpdatePlan = UpdatePlan+  { applications :: [AppliedComposition],+    versionChanges :: [VersionChange],+    inputChanges :: InputChangeSummary,+    migrations :: [PlannedUpdateMigration],+    reconciliation :: ReconciliationPlan,+    commandPlan :: CommandPlan,+    candidateArtifacts :: [CandidateArtifact],+    warnings :: [UpdateWarning],+    request :: UpdateRequest,+    snapshot :: UpdateSnapshot,+    plannedApplications :: [PlannedApplication]+  }+  deriving stock (Eq, Show)++data CommandSummary = CommandSummary+  { executed :: Int,+    skippedUnchanged :: Int,+    skippedDisabled :: Int+  }+  deriving stock (Eq, Show)++data UpdateResult = UpdateResult+  { updatedApplications :: [ApplicationId],+    manifest :: Manifest,+    versions :: [VersionChange],+    fileSummary :: ReconciliationSummary,+    commandSummary :: CommandSummary,+    touchedPaths :: Set FilePath,+    warnings :: [UpdateWarning]+  }+  deriving stock (Eq, Show)++data UpdateError+  = UpdateManifestMissing FilePath+  | UpdateManifestUnreadable FilePath Text+  | NoRecordedApplications+  | LegacyUpdateRequiresOneTarget+  | UpdateTargetNotFound Text [Text]+  | SharedPathRequiresApplications FilePath (Set ApplicationId) (Set ApplicationId)+  | CandidateCloneFailed Text Text+  | CandidateRepositoryInvalid Text [Text]+  | CandidateArtifactMissing CandidateArtifactKind Text+  | CandidateArtifactAmbiguous CandidateArtifactKind Text [Text]+  | CandidateLoadFailed Text ModuleLoadError+  | CandidateDowngrade Text (Maybe Text) (Maybe Text)+  | CandidateVersionInvalid Text Text+  | UpdateConflictingPriorVersions ModuleName [Text]+  | UpdateVariableErrors [VarError]+  | UpdateConfigurationFailed Text+  | UpdateMigrationPlanFailed ModuleName MigrationPlanError+  | UpdateMigrationStageFailed ModuleName MigrationExecError+  | UpdateCompositionFailed [Text]+  | UpdateReconciliationFailed ReconciliationError+  | UpdateHasUnresolvedPaths (Set FilePath)+  | UpdateRecoveryFailed [TransactionError]+  | UpdatePlanStale (Set FilePath)+  | UpdateTransactionFailed TransactionError+  | UpdateMigrationFailed ModuleName MigrationExecError+  | UpdateChangedAfterMigrationCommand ReconciliationSummary ReconciliationSummary+  | UpdateCommandFailed CommandExecutionError [UpdateWarning]+  | UpdateCachePublicationFailed Text+  | UpdateManifestWriteFailed Text+  deriving stock (Eq, Show)
test/Main.hs view
@@ -1,10 +1,16 @@ module Main (main) where  import Seihou.CLI.AgentCompletionSpec qualified as AgentCompletionSpec+import Seihou.CLI.AgentConfigShowSpec qualified as AgentConfigShowSpec import Seihou.CLI.AgentConfigSpec qualified as AgentConfigSpec import Seihou.CLI.AgentLaunchSpec qualified as AgentLaunchSpec+import Seihou.CLI.AgentMigrateE2ESpec qualified as AgentMigrateE2ESpec+import Seihou.CLI.AgentModelsSpec qualified as AgentModelsSpec+import Seihou.CLI.AppliedBlueprintMigrationSpec qualified as AppliedBlueprintMigrationSpec import Seihou.CLI.AppliedBlueprintSpec qualified as AppliedBlueprintSpec+import Seihou.CLI.BlueprintMigrationSpec qualified as BlueprintMigrationSpec import Seihou.CLI.BrowseFormatSpec qualified as BrowseFormatSpec+import Seihou.CLI.CommandExecutionSpec qualified as CommandExecutionSpec import Seihou.CLI.CommitMessageSpec qualified as CommitMessageSpec import Seihou.CLI.DiffSpec qualified as DiffSpec import Seihou.CLI.ExtensionSpec qualified as ExtensionSpec@@ -21,6 +27,10 @@ import Seihou.CLI.RunBlueprintRefusalSpec qualified as RunBlueprintRefusalSpec import Seihou.CLI.SavePromptedSpec qualified as SavePromptedSpec import Seihou.CLI.StatusSpec qualified as StatusSpec+import Seihou.CLI.UpdateE2ESpec qualified as UpdateE2ESpec+import Seihou.CLI.UpdateInteractionSpec qualified as UpdateInteractionSpec+import Seihou.CLI.UpdateRenderSpec qualified as UpdateRenderSpec+import Seihou.CLI.UpdateSpec qualified as UpdateSpec import Seihou.CLI.UpgradeSpec qualified as UpgradeSpec import Seihou.FzfSpec qualified as FzfSpec import Test.Tasty@@ -30,11 +40,17 @@   tests <-     sequence       [ AgentLaunchSpec.tests,+        AgentMigrateE2ESpec.tests,         AgentCompletionSpec.tests,         AgentConfigSpec.tests,+        AgentConfigShowSpec.tests,+        AgentModelsSpec.tests,         AppliedBlueprintSpec.tests,+        AppliedBlueprintMigrationSpec.tests,+        BlueprintMigrationSpec.tests,         BrowseFormatSpec.tests,         CommitMessageSpec.tests,+        CommandExecutionSpec.tests,         DiffSpec.tests,         ExtensionSpec.tests,         GitSpec.tests,@@ -51,6 +67,10 @@         SavePromptedSpec.tests,         StatusSpec.tests,         UpgradeSpec.tests,+        UpdateSpec.tests,+        UpdateInteractionSpec.tests,+        UpdateE2ESpec.tests,+        UpdateRenderSpec.tests,         FzfSpec.tests       ]   defaultMain (testGroup "seihou-cli" tests)
test/Seihou/CLI/AgentCompletionSpec.hs view
@@ -40,7 +40,8 @@       defaultAgentModelConfig         `shouldBe` AgentModelConfig           { agentProvider = AgentProviderClaudeCli,-            agentModel = Nothing+            agentModel = Nothing,+            agentEffort = Nothing           }      it "builds a Claude CLI model using the CLI API tag" $ do@@ -48,7 +49,8 @@             buildBaikaiModel               AgentModelConfig                 { agentProvider = AgentProviderClaudeCli,-                  agentModel = Just "sonnet"+                  agentModel = Just "sonnet",+                  agentEffort = Nothing                 }       BaikaiModel.api model `shouldBe` Baikai.AnthropicMessagesCli       BaikaiModel.provider model `shouldBe` "anthropic"@@ -59,7 +61,8 @@             buildBaikaiModel               AgentModelConfig                 { agentProvider = AgentProviderCodexCli,-                  agentModel = Just "gpt-5"+                  agentModel = Just "gpt-5",+                  agentEffort = Nothing                 }       BaikaiModel.api model `shouldBe` Baikai.OpenAICompletionsCli       BaikaiModel.provider model `shouldBe` "openai"@@ -70,7 +73,8 @@       let config =             AgentModelConfig               { agentProvider = AgentProviderCodexCli,-                agentModel = Just "gpt-5"+                agentModel = Just "gpt-5",+                agentEffort = Nothing               }       buildAgentCompletionRequest config "system" (Just "user")         `shouldBe` AgentCompletionRequest
+ test/Seihou/CLI/AgentConfigShowSpec.hs view
@@ -0,0 +1,81 @@+module Seihou.CLI.AgentConfigShowSpec (tests) where++import Baikai.ThinkingLevel (ThinkingLevel (..))+import Data.Text (Text)+import Data.Text qualified as Text+import Seihou.CLI.AgentCompletion (AgentProvider (..))+import Seihou.CLI.AgentConfig+  ( AgentCommandName (..),+    AgentConfigSource (..),+    ResolvedAgentField (..),+    ResolvedCommandConfig (..),+  )+import Seihou.CLI.AgentConfigShow (formatResolvedAgentConfig)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.AgentConfigShow" spec++spec :: Spec+spec =+  describe "formatResolvedAgentConfig" $ do+    let rendered = formatResolvedAgentConfig sample+        -- A line exists containing every fragment (order-independent).+        hasLine fragments =+          any (\ln -> all (`Text.isInfixOf` ln) fragments) (Text.lines rendered)++    -- The command label is printed on the provider row; the model row's label+    -- column is blank, so model-row assertions match on value + source only+    -- (each is unique to one command in the sample).+    it "labels a per-command local model with its concrete key" $+      hasLine ["model", "claude-opus-4-8", "[local: agent.run.model]"] `shouldBe` True++    it "shows an unset model as (default) with built-in provenance" $+      hasLine ["model", "(default)", "[built-in default]"] `shouldBe` True++    it "labels a global default model with the shared key" $+      hasLine ["model", "claude-sonnet-5", "[global: agent.model]"] `shouldBe` True++    it "labels a global per-command provider with its command key on the labelled row" $+      hasLine ["assist", "provider", "codex-cli", "[global: agent.assist.provider]"] `shouldBe` True++    it "renders the migrate command and its concrete config key" $+      hasLine ["migrate", "model", "gpt-5-mini", "[local: agent.migrate.model]"] `shouldBe` True++    it "labels a per-command local effort with its concrete key" $+      hasLine ["effort", "max", "[local: agent.run.effort]"] `shouldBe` True++    it "labels a global default effort with the shared key" $+      hasLine ["effort", "high", "[global: agent.effort]"] `shouldBe` True++    it "shows an unset effort as (default) with built-in provenance" $+      hasLine ["effort", "(default)", "[built-in default]"] `shouldBe` True++    it "includes the precedence legend" $+      ("Precedence, highest first:" `Text.isInfixOf` rendered) `shouldBe` True++sample :: [ResolvedCommandConfig]+sample =+  [ ResolvedCommandConfig+      AgentCmdAssist+      (ResolvedAgentField AgentProviderCodexCli SourceGlobalCommand)+      (ResolvedAgentField Nothing SourceBuiltinDefault)+      (ResolvedAgentField (Just ThinkingHigh) SourceGlobalDefault),+    ResolvedCommandConfig+      AgentCmdBootstrap+      (ResolvedAgentField AgentProviderClaudeCli SourceBuiltinDefault)+      (ResolvedAgentField (Just "claude-sonnet-5") SourceGlobalDefault)+      (ResolvedAgentField Nothing SourceBuiltinDefault),+    ResolvedCommandConfig+      AgentCmdRun+      (ResolvedAgentField AgentProviderClaudeCli SourceBuiltinDefault)+      (ResolvedAgentField (Just "claude-opus-4-8") SourceLocalCommand)+      (ResolvedAgentField (Just ThinkingMax) SourceLocalCommand),+    ResolvedCommandConfig+      AgentCmdMigrate+      (ResolvedAgentField AgentProviderOpenAI SourceLocalCommand)+      (ResolvedAgentField (Just "gpt-5-mini") SourceLocalCommand)+      (ResolvedAgentField Nothing SourceBuiltinDefault)+  ]
test/Seihou/CLI/AgentConfigSpec.hs view
@@ -1,5 +1,6 @@ module Seihou.CLI.AgentConfigSpec (tests) where +import Baikai.ThinkingLevel (ThinkingLevel (..)) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as Text@@ -15,36 +16,29 @@ spec :: Spec spec = do   describe "resolveAgentModelConfig" $ do-    it "uses CLI flags before environment variables" $ do+    it "uses CLI flags before environment variables" $       resolveAgentModelConfig         (baseInputs {cliProvider = Just "codex-cli", cliModel = Just "gpt-5", envProvider = Just "anthropic", envModel = Just "claude-sonnet-4-6"})-        `shouldBe` Right-          AgentModelConfig-            { agentProvider = AgentProviderCodexCli,-              agentModel = Just "gpt-5"-            }+        `shouldBe` Right (cfg AgentProviderCodexCli (Just "gpt-5")) -    it "uses environment variables before local config" $ do+    it "uses environment variables before local config" $       resolveAgentModelConfig         (baseInputs {envProvider = Just "openai", envModel = Just "gpt-4o", localConfig = config "anthropic" "claude-sonnet-4-6"})-        `shouldBe` Right-          AgentModelConfig-            { agentProvider = AgentProviderOpenAI,-              agentModel = Just "gpt-4o"-            }+        `shouldBe` Right (cfg AgentProviderOpenAI (Just "gpt-4o")) -    it "uses local config before global config" $ do+    it "uses local config before global config" $       resolveAgentModelConfig         (baseInputs {localConfig = config "anthropic" "claude-opus-4-1", globalConfig = config "openai" "gpt-4o-mini"})-        `shouldBe` Right-          AgentModelConfig-            { agentProvider = AgentProviderAnthropic,-              agentModel = Just "claude-opus-4-1"-            }+        `shouldBe` Right (cfg AgentProviderAnthropic (Just "claude-opus-4-1")) -    it "falls back to the Claude CLI default" $-      resolveAgentModelConfig baseInputs `shouldBe` Right defaultAgentModelConfig+    it "pins the deterministic claude-cli default model when nothing is set" $+      resolveAgentModelConfig baseInputs+        `shouldBe` Right (cfg AgentProviderClaudeCli (Just "claude-opus-4-8")) +    it "pins the deterministic codex-cli default model when only the provider is set" $+      resolveAgentModelConfig (baseInputs {cliProvider = Just "codex-cli"})+        `shouldBe` Right (cfg AgentProviderCodexCli (Just "gpt-5.6-terra"))+     it "returns provider diagnostics for invalid provider text" $       resolveAgentModelConfig (baseInputs {cliProvider = Just "llama"}) `shouldSatisfy` \case         Left err ->@@ -55,31 +49,151 @@      it "allows a model-only override while keeping the default provider" $       resolveAgentModelConfig (baseInputs {cliModel = Just "sonnet"})-        `shouldBe` Right-          AgentModelConfig-            { agentProvider = AgentProviderClaudeCli,-              agentModel = Just "sonnet"-            }+        `shouldBe` Right (cfg AgentProviderClaudeCli (Just "sonnet"))      it "ignores blank higher-precedence values" $       resolveAgentModelConfig         (baseInputs {cliProvider = Just "  ", envProvider = Just "codex-cli", cliModel = Just "", envModel = Just "gpt-5"})-        `shouldBe` Right-          AgentModelConfig-            { agentProvider = AgentProviderCodexCli,-              agentModel = Just "gpt-5"-            }+        `shouldBe` Right (cfg AgentProviderCodexCli (Just "gpt-5")) +  describe "resolveAgentModelConfigFor (per-command)" $ do+    it "prefers a per-command model over the default in the same scope" $ do+      let inputs =+            baseInputs+              { localConfig =+                  Map.fromList+                    [ (agentModelConfigKey, "claude-sonnet-5"),+                      (agentCommandModelConfigKey AgentCmdRun, "claude-opus-4-8")+                    ]+              }+      modelOf AgentCmdRun inputs `shouldBe` Right (Just "claude-opus-4-8", SourceLocalCommand)+      modelOf AgentCmdAssist inputs `shouldBe` Right (Just "claude-sonnet-5", SourceLocalDefault)++    it "lets a local default override a global per-command key (project over global)" $ do+      let inputs =+            baseInputs+              { localConfig = Map.fromList [(agentModelConfigKey, "claude-sonnet-5")],+                globalConfig = Map.fromList [(agentCommandModelConfigKey AgentCmdRun, "gpt-5")]+              }+      modelOf AgentCmdRun inputs `shouldBe` Right (Just "claude-sonnet-5", SourceLocalDefault)++    it "prefers a global per-command key over the global default" $ do+      let inputs =+            baseInputs+              { globalConfig =+                  Map.fromList+                    [ (agentProviderConfigKey, "anthropic"),+                      (agentCommandProviderConfigKey AgentCmdAssist, "openai")+                    ]+              }+      providerOf AgentCmdAssist inputs `shouldBe` Right (AgentProviderOpenAI, SourceGlobalCommand)+      providerOf AgentCmdSetup inputs `shouldBe` Right (AgentProviderAnthropic, SourceGlobalDefault)++    it "labels a subcommand CLI flag distinctly from a parent flag" $ do+      providerOf AgentCmdAssist (baseInputs {cliProvider = Just "codex-cli", cliProviderFromSubcommand = True})+        `shouldBe` Right (AgentProviderCodexCli, SourceCliSubcommand)+      providerOf AgentCmdAssist (baseInputs {cliProvider = Just "codex-cli", cliProviderFromSubcommand = False})+        `shouldBe` Right (AgentProviderCodexCli, SourceCliParent)++    it "falls back to the pinned CLI default model with built-in provenance" $ do+      providerOf AgentCmdRun baseInputs `shouldBe` Right (AgentProviderClaudeCli, SourceBuiltinDefault)+      modelOf AgentCmdRun baseInputs `shouldBe` Right (Just "claude-opus-4-8", SourceBuiltinDefault)++    it "keeps claude-cli and codex-cli deterministic: model is never Nothing" $ do+      -- With nothing configured, every command resolves to a concrete model for+      -- both local CLI providers, so seihou always passes an explicit --model.+      modelOf AgentCmdAssist baseInputs `shouldBe` Right (Just "claude-opus-4-8", SourceBuiltinDefault)+      modelOf AgentCmdAssist (baseInputs {cliProvider = Just "codex-cli", cliProviderFromSubcommand = True})+        `shouldBe` Right (Just "gpt-5.6-terra", SourceBuiltinDefault)++    it "keeps environment variables above per-command config" $ do+      let inputs =+            baseInputs+              { envModel = Just "gpt-5",+                localConfig = Map.fromList [(agentCommandModelConfigKey AgentCmdRun, "claude-opus-4-8")]+              }+      modelOf AgentCmdRun inputs `shouldBe` Right (Just "gpt-5", SourceEnv)++    it "resolves migrate from its own per-command keys" $ do+      let inputs =+            baseInputs+              { localConfig =+                  Map.fromList+                    [ (agentCommandProviderConfigKey AgentCmdMigrate, "openai"),+                      (agentCommandModelConfigKey AgentCmdMigrate, "gpt-5-mini"),+                      (agentCommandModelConfigKey AgentCmdRun, "claude-opus-4-8")+                    ]+              }+      providerOf AgentCmdMigrate inputs `shouldBe` Right (AgentProviderOpenAI, SourceLocalCommand)+      modelOf AgentCmdMigrate inputs `shouldBe` Right (Just "gpt-5-mini", SourceLocalCommand)+      modelOf AgentCmdRun inputs `shouldBe` Right (Just "claude-opus-4-8", SourceLocalCommand)++  describe "resolveAgentModelConfigFor (reasoning effort)" $ do+    it "defaults to unset effort when nothing is configured" $+      effortOf AgentCmdRun baseInputs `shouldBe` Right (Nothing, SourceBuiltinDefault)++    it "prefers a per-command effort over the shared default in the same scope" $ do+      let inputs =+            baseInputs+              { localConfig =+                  Map.fromList+                    [ (agentEffortConfigKey, "medium"),+                      (agentCommandEffortConfigKey AgentCmdRun, "max")+                    ]+              }+      effortOf AgentCmdRun inputs `shouldBe` Right (Just ThinkingMax, SourceLocalCommand)+      effortOf AgentCmdAssist inputs `shouldBe` Right (Just ThinkingMedium, SourceLocalDefault)++    it "lets a local default effort override a global per-command effort" $ do+      let inputs =+            baseInputs+              { localConfig = Map.fromList [(agentEffortConfigKey, "low")],+                globalConfig = Map.fromList [(agentCommandEffortConfigKey AgentCmdRun, "max")]+              }+      effortOf AgentCmdRun inputs `shouldBe` Right (Just ThinkingLow, SourceLocalDefault)++    it "keeps the effort environment variable above config" $ do+      let inputs =+            baseInputs+              { envEffort = Just "high",+                localConfig = Map.fromList [(agentCommandEffortConfigKey AgentCmdRun, "minimal")]+              }+      effortOf AgentCmdRun inputs `shouldBe` Right (Just ThinkingHigh, SourceEnv)++    it "prefers the subcommand effort flag over everything" $+      effortOf+        AgentCmdRun+        (baseInputs {cliEffort = Just "xhigh", cliEffortFromSubcommand = True, envEffort = Just "low"})+        `shouldBe` Right (Just ThinkingXHigh, SourceCliSubcommand)++    it "parses effort case-insensitively" $+      effortOf AgentCmdRun (baseInputs {cliEffort = Just "  MAX  "}) `shouldBe` Right (Just ThinkingMax, SourceCliParent)++    it "returns a diagnostic for an invalid effort value" $+      resolveAgentModelConfigFor AgentCmdRun (baseInputs {cliEffort = Just "ultra"}) `shouldSatisfy` \case+        Left err -> "Unknown reasoning effort" `Text.isInfixOf` err && "xhigh" `Text.isInfixOf` err+        Right _ -> False++providerOf :: AgentCommandName -> AgentConfigInputs -> Either Text (AgentProvider, AgentConfigSource)+providerOf c inputs =+  (\(p, _, _) -> (p.resolvedValue, p.resolvedSource)) <$> resolveAgentModelConfigFor c inputs++modelOf :: AgentCommandName -> AgentConfigInputs -> Either Text (Maybe Text, AgentConfigSource)+modelOf c inputs =+  (\(_, m, _) -> (m.resolvedValue, m.resolvedSource)) <$> resolveAgentModelConfigFor c inputs++effortOf :: AgentCommandName -> AgentConfigInputs -> Either Text (Maybe ThinkingLevel, AgentConfigSource)+effortOf c inputs =+  (\(_, _, e) -> (e.resolvedValue, e.resolvedSource)) <$> resolveAgentModelConfigFor c inputs++-- | Build an expected 'AgentModelConfig' with effort unset (the flat resolver+-- never sets effort).+cfg :: AgentProvider -> Maybe Text -> AgentModelConfig+cfg provider model =+  AgentModelConfig {agentProvider = provider, agentModel = model, agentEffort = Nothing}+ baseInputs :: AgentConfigInputs-baseInputs =-  AgentConfigInputs-    { cliProvider = Nothing,-      cliModel = Nothing,-      envProvider = Nothing,-      envModel = Nothing,-      localConfig = Map.empty,-      globalConfig = Map.empty-    }+baseInputs = baseAgentConfigInputs  config :: Text -> Text -> Map.Map Text Text config provider model =
test/Seihou/CLI/AgentLaunchSpec.hs view
@@ -150,7 +150,8 @@               baseModules = [],               files = [],               allowedTools = Nothing,-              tags = []+              tags = [],+              migrations = []             }     it "renders name, version, description as a three-line block" $       formatBlueprintIdentity (mk (Just "0.1") (Just "a thing"))
+ test/Seihou/CLI/AgentMigrateE2ESpec.hs view
@@ -0,0 +1,191 @@+module Seihou.CLI.AgentMigrateE2ESpec (tests) where++import Data.ByteString.Lazy qualified as LBS+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Core.Types (AppliedBlueprintMigration (..), Manifest (..))+import Seihou.Manifest.Types (manifestFromJSON)+import System.Directory+  ( createDirectoryIfMissing,+    doesFileExist,+    executable,+    getPermissions,+    setPermissions,+  )+import System.Environment (getEnvironment, getExecutablePath)+import System.Exit (ExitCode (..))+import System.FilePath (searchPathSeparator, takeDirectory, (</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode)+import Test.Hspec+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Agent migrate end-to-end" $ do+  it "exposes the required version window and rerun option in help" $ do+    binary <- seihouBinary+    (exitCode, output, _) <- runProcessText binary ["agent", "migrate", "--help"] Nothing Nothing+    exitCode `shouldBe` ExitSuccess+    output `shouldSatisfy` T.isInfixOf "Usage: seihou agent migrate BLUEPRINT --from VERSION --to VERSION [PROMPT]"+    output `shouldSatisfy` T.isInfixOf "--rerun"+    output `shouldNotSatisfy` T.isInfixOf "--no-baseline"+    output `shouldNotSatisfy` T.isInfixOf "--force"++  it "renders gap-tolerant pending prompts in order without writing a receipt" $+    withSystemTempDirectory "seihou-agent-migrate-debug" $ \root -> do+      binary <- seihouBinary+      let blueprintDir = root </> ".seihou" </> "modules" </> "payments"+          blueprintPath = blueprintDir </> "blueprint.dhall"+          manifestPath = root </> ".seihou" </> "manifest.json"+          xdgHome = root </> "xdg"+      createDirectoryIfMissing True blueprintDir+      createDirectoryIfMissing True xdgHome+      TIO.writeFile blueprintPath migrationBlueprintDhall+      inherited <- getEnvironment+      let overriddenNames = ["XDG_CONFIG_HOME", "SEIHOU_AGENT_PROVIDER", "SEIHOU_AGENT_MODEL", "SEIHOU_CONTEXT"]+          environment =+            ("XDG_CONFIG_HOME", xdgHome)+              : ("SEIHOU_AGENT_PROVIDER", "claude-cli")+              : filter (\(key, _) -> key `notElem` overriddenNames) inherited+      (exitCode, output, errorOutput) <-+        runProcessText+          binary+          [ "agent",+            "--debug",+            "migrate",+            "payments",+            "--from",+            "1.0.0",+            "--to",+            "3.0.0",+            "--var",+            "library.name=baikai"+          ]+          (Just root)+          (Just environment)+      case exitCode of+        ExitSuccess -> pure ()+        ExitFailure code ->+          expectationFailure $+            "debug migration exited "+              <> show code+              <> "\nstdout:\n"+              <> T.unpack output+              <> "\nstderr:\n"+              <> T.unpack errorOutput+      output `shouldSatisfy` T.isInfixOf "Blueprint migrations for payments: 1.0.0 -> 3.0.0"+      output `shouldSatisfy` T.isInfixOf "===== [1/2] 1.0.0 -> 2.0.0 ====="+      output `shouldSatisfy` T.isInfixOf "===== [2/2] 2.5.0 -> 3.0.0 ====="+      output `shouldSatisfy` T.isInfixOf "Shared upgrade guidance for baikai."+      output `shouldSatisfy` T.isInfixOf "Replace baikai legacy calls."+      let (_, afterFirst) = T.breakOn "1.0.0 -> 2.0.0" output+          (_, afterSecond) = T.breakOn "2.5.0 -> 3.0.0" afterFirst+      afterFirst `shouldNotBe` ""+      afterSecond `shouldNotBe` ""+      doesFileExist manifestPath `shouldReturn` False++  it "records successful edges and skips them on the next invocation" $+    withSystemTempDirectory "seihou-agent-migrate-receipts" $ \root -> do+      binary <- seihouBinary+      let blueprintDir = root </> ".seihou" </> "modules" </> "payments"+          blueprintPath = blueprintDir </> "blueprint.dhall"+          manifestPath = root </> ".seihou" </> "manifest.json"+          xdgHome = root </> "xdg"+          fakeBin = root </> "bin"+          fakeClaude = fakeBin </> "claude"+          launchLog = root </> "agent-launches.log"+      createDirectoryIfMissing True blueprintDir+      createDirectoryIfMissing True xdgHome+      createDirectoryIfMissing True fakeBin+      TIO.writeFile blueprintPath migrationBlueprintDhall+      TIO.writeFile fakeClaude "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nexit 0\n"+      permissions <- getPermissions fakeClaude+      setPermissions fakeClaude (permissions {executable = True})++      inherited <- getEnvironment+      let inheritedPath = fromMaybe "" (lookup "PATH" inherited)+          overriddenNames = ["PATH", "XDG_CONFIG_HOME", "SEIHOU_AGENT_PROVIDER", "SEIHOU_AGENT_MODEL", "SEIHOU_CONTEXT", "SEIHOU_FAKE_AGENT_LOG"]+          environment =+            ("PATH", fakeBin <> [searchPathSeparator] <> inheritedPath)+              : ("XDG_CONFIG_HOME", xdgHome)+              : ("SEIHOU_AGENT_PROVIDER", "claude-cli")+              : ("SEIHOU_FAKE_AGENT_LOG", launchLog)+              : filter (\(key, _) -> key `notElem` overriddenNames) inherited+          args =+            [ "agent",+              "migrate",+              "payments",+              "--from",+              "1.0.0",+              "--to",+              "3.0.0",+              "--var",+              "library.name=baikai"+            ]++      (firstExit, _, firstError) <- runProcessText binary args (Just root) (Just environment)+      case firstExit of+        ExitSuccess -> pure ()+        ExitFailure code -> expectationFailure ("migration exited " <> show code <> "\nstderr:\n" <> T.unpack firstError)+      T.lines <$> TIO.readFile launchLog `shouldReturn` ["called", "called"]+      beforeResume <- LBS.readFile manifestPath+      manifest <-+        case manifestFromJSON beforeResume of+          Left err -> expectationFailure err >> fail "unreachable"+          Right decoded -> pure decoded+      map (\receipt -> (receipt.fromVersion, receipt.toVersion)) manifest.blueprintMigrations+        `shouldBe` [("1.0.0", "2.0.0"), ("2.5.0", "3.0.0")]++      (resumeExit, resumeOutput, resumeError) <- runProcessText binary args (Just root) (Just environment)+      case resumeExit of+        ExitSuccess -> pure ()+        ExitFailure code -> expectationFailure ("resume exited " <> show code <> "\nstderr:\n" <> T.unpack resumeError)+      resumeOutput `shouldSatisfy` T.isInfixOf "already have receipts"+      T.lines <$> TIO.readFile launchLog `shouldReturn` ["called", "called"]+      LBS.readFile manifestPath `shouldReturn` beforeResume++seihouBinary :: IO FilePath+seihouBinary = do+  testBinary <- getExecutablePath+  pure (takeDirectory (takeDirectory testBinary) </> "seihou" </> "seihou")++runProcessText ::+  FilePath ->+  [String] ->+  Maybe FilePath ->+  Maybe [(String, String)] ->+  IO (ExitCode, T.Text, T.Text)+runProcessText binary args workingDirectory environment = do+  let command = (proc binary args) {cwd = workingDirectory, env = environment}+  (exitCode, stdoutText, stderrText) <- readCreateProcessWithExitCode command ""+  pure (exitCode, T.pack stdoutText, T.pack stderrText)++migrationBlueprintDhall :: T.Text+migrationBlueprintDhall =+  T.unlines+    [ "{ name = \"payments\"",+      ", version = Some \"4.2.0\"",+      ", description = Some \"Payments library upgrade\"",+      ", prompt = \"Shared upgrade guidance for {{library.name}}.\"",+      ", vars =",+      "  [ { name = \"library.name\"",+      "    , type = \"text\"",+      "    , default = None Text",+      "    , description = None Text",+      "    , required = True",+      "    , validation = None Text",+      "    }",+      "  ]",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", baseModules = [] : List { module : Text, vars : List { name : Text, value : Text } }",+      ", files = [] : List { src : Text, description : Optional Text }",+      ", allowedTools = None (List Text)",+      ", tags = [] : List Text",+      ", migrations =",+      "  [ { from = \"2.5.0\", to = \"3.0.0\", prompt = \"Finish the baikai upgrade.\" }",+      "  , { from = \"1.0.0\", to = \"2.0.0\", prompt = \"Replace {{library.name}} legacy calls.\" }",+      "  ]",+      "}"+    ]
+ test/Seihou/CLI/AgentModelsSpec.hs view
@@ -0,0 +1,66 @@+module Seihou.CLI.AgentModelsSpec (tests) where++import Baikai.Model (Model)+import Baikai.Model qualified as BaikaiModel+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Seihou.CLI.AgentCompletion (AgentProvider (..))+import Seihou.CLI.AgentModels+import Test.Hspec+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.AgentModels" $ do+  describe "availableAgentModels" $ do+    it "contains 31 unique Anthropic and OpenAI model IDs" $ do+      let ids = modelIds availableAgentModels+      length ids `shouldBe` 31+      Set.size (Set.fromList ids) `shouldBe` 31+      Set.fromList (map BaikaiModel.provider availableAgentModels)+        `shouldBe` Set.fromList ["anthropic", "openai"]++    it "contains the newest Claude and GPT-5.6 models" $+      modelIds availableAgentModels+        `shouldSatisfy` \ids ->+          all+            (`elem` ids)+            ["claude-sonnet-5", "gpt-5.6", "gpt-5.6-luna", "gpt-5.6-sol", "gpt-5.6-terra"]++  describe "filterAgentModels" $ do+    it "maps the Anthropic API and Claude CLI providers to the same 9 models" $ do+      let anthropicIds = filteredIds AgentProviderAnthropic+          claudeCliIds = filteredIds AgentProviderClaudeCli+      anthropicIds `shouldBe` claudeCliIds+      length anthropicIds `shouldBe` 9++    it "maps the OpenAI API and Codex CLI providers to the same 22 models" $ do+      let openAIIds = filteredIds AgentProviderOpenAI+          codexCliIds = filteredIds AgentProviderCodexCli+      openAIIds `shouldBe` codexCliIds+      length openAIIds `shouldBe` 22++  describe "formatAgentModels" $ do+    it "renders model names, compatible providers, count, and alias guidance" $ do+      let output = formatAgentModels Nothing availableAgentModels+      output `shouldSatisfy` Text.isInfixOf "MODEL"+      output `shouldSatisfy` Text.isInfixOf "Claude Sonnet 5"+      output `shouldSatisfy` Text.isInfixOf "anthropic, claude-cli"+      output `shouldSatisfy` Text.isInfixOf "GPT-5.6 Terra"+      output `shouldSatisfy` Text.isInfixOf "openai, codex-cli"+      output `shouldSatisfy` Text.isInfixOf "31 models found."+      output `shouldSatisfy` Text.isInfixOf "aliases and custom model IDs remain accepted"++    it "reports the filtered model count" $ do+      formatAgentModels (Just AgentProviderAnthropic) availableAgentModels+        `shouldSatisfy` Text.isInfixOf "9 models found."+      formatAgentModels (Just AgentProviderCodexCli) availableAgentModels+        `shouldSatisfy` Text.isInfixOf "22 models found."++modelIds :: [Model] -> [Text]+modelIds = map BaikaiModel.modelId++filteredIds :: AgentProvider -> [Text]+filteredIds provider =+  modelIds (filterAgentModels (Just provider) availableAgentModels)
+ test/Seihou/CLI/AppliedBlueprintMigrationSpec.hs view
@@ -0,0 +1,80 @@+module Seihou.CLI.AppliedBlueprintMigrationSpec (tests) where++import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Seihou.CLI.AppliedBlueprintMigration (recordAppliedBlueprintMigration)+import Seihou.Core.Types (AppliedBlueprintMigration (..), Manifest (..), ModuleName (..))+import Seihou.Manifest.Types (currentManifestVersion, manifestFromJSON)+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.CLI.AppliedBlueprintMigration" spec++fixedTime :: UTCTime+fixedTime =+  parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-20T12:00:00Z"++fixedTime2 :: UTCTime+fixedTime2 =+  parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-20T13:00:00Z"++mkReceipt :: T.Text -> T.Text -> T.Text -> UTCTime -> AppliedBlueprintMigration+mkReceipt blueprintName fromVersion toVersion appliedAt =+  AppliedBlueprintMigration+    { name = ModuleName blueprintName,+      blueprintVersion = Just "0.4.0",+      fromVersion = fromVersion,+      toVersion = toVersion,+      appliedAt = appliedAt,+      agentSessionId = Nothing+    }++readManifestFile :: FilePath -> IO Manifest+readManifestFile path = do+  bytes <- LBS.readFile path+  case manifestFromJSON bytes of+    Right manifest -> pure manifest+    Left err -> error ("test fixture: malformed manifest: " <> err)++spec :: Spec+spec = describe "recordAppliedBlueprintMigration" $ do+  it "creates a version-5 manifest for the first receipt" $+    withSystemTempDirectory "seihou-blueprint-migration" $ \dir -> do+      let manifestPath = dir </> ".seihou" </> "manifest.json"+          receipt = mkReceipt "payments" "1.0.0" "2.0.0" fixedTime+      result <- recordAppliedBlueprintMigration manifestPath receipt+      result `shouldBe` Right ()+      manifest <- readManifestFile manifestPath+      manifest.version `shouldBe` currentManifestVersion+      manifest.blueprintMigrations `shouldBe` [receipt]++  it "upserts the same exact edge and retains unrelated edges" $+    withSystemTempDirectory "seihou-blueprint-migration" $ \dir -> do+      let manifestPath = dir </> "manifest.json"+          first = mkReceipt "payments" "1.0.0" "2.0.0" fixedTime+          second = mkReceipt "payments" "2.5.0" "3.0.0" fixedTime+          replacement =+            (mkReceipt "payments" "1.0.0" "2.0.0" fixedTime2)+              { blueprintVersion = Just "0.5.0"+              }+      recordAppliedBlueprintMigration manifestPath first `shouldReturn` Right ()+      recordAppliedBlueprintMigration manifestPath second `shouldReturn` Right ()+      recordAppliedBlueprintMigration manifestPath replacement `shouldReturn` Right ()+      manifest <- readManifestFile manifestPath+      manifest.blueprintMigrations `shouldBe` [replacement, second]++  it "returns Left and preserves a corrupt existing manifest" $+    withSystemTempDirectory "seihou-blueprint-migration" $ \dir -> do+      let manifestPath = dir </> "manifest.json"+          corrupt = "{ this is not valid json"+      writeFile manifestPath corrupt+      result <- recordAppliedBlueprintMigration manifestPath (mkReceipt "payments" "1.0.0" "2.0.0" fixedTime)+      case result of+        Left err -> err `shouldSatisfy` not . T.null+        Right () -> expectationFailure "expected corrupt manifest failure"+      readFile manifestPath `shouldReturn` corrupt
+ test/Seihou/CLI/BlueprintMigrationSpec.hs view
@@ -0,0 +1,248 @@+module Seihou.CLI.BlueprintMigrationSpec (tests) where++import Data.IORef+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime)+import Seihou.CLI.AgentLaunch (AgentContext (..))+import Seihou.CLI.BlueprintExecution (PreparedBlueprintExecution (..))+import Seihou.CLI.BlueprintMigration+import Seihou.Core.Migration+import Seihou.Core.Types+import Seihou.Core.Version (Version, parseVersion)+import System.Exit (ExitCode (..))+import Test.Hspec+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.BlueprintMigration" $ do+  describe "pendingBlueprintMigrations" $ do+    it "retains the planner's order across an intentional version gap" $ do+      let late = migration "2.5.0" "3.0.0"+          early = migration "1.0.0" "2.0.0"+          Right (Just migrationPlan) =+            planBlueprintMigrationChain+              "payments"+              [late, early]+              (version "1.0.0")+              (version "3.0.0")+      pendingBlueprintMigrations False blueprintName [] migrationPlan+        `shouldBe` [early, late]++    it "resumes by filtering only an already-recorded exact edge" $ do+      let migrationPlan = plan [first, second]+          receipts =+            [ receipt blueprintName "1.0.0" "2.0.0",+              receipt "another-blueprint" "2.0.0" "3.0.0"+            ]+      pendingBlueprintMigrations False blueprintName receipts migrationPlan+        `shouldBe` [second]++    it "keeps recorded edges when rerun is requested" $ do+      let migrationPlan = plan [first, second]+          receipts = [receipt blueprintName "1.0.0" "2.0.0"]+      pendingBlueprintMigrations True blueprintName receipts migrationPlan+        `shouldBe` [first, second]++  describe "renderBlueprintMigrationInstruction" $ do+    it "substitutes the variables resolved for the shared blueprint" $ do+      let declaration = VarDecl "library.name" VTText Nothing Nothing False Nothing+          resolved =+            Map.singleton+              "library.name"+              (ResolvedVar (VText "baikai") FromDefault declaration)+      renderBlueprintMigrationInstruction resolved (migrationWithPrompt "1" "2" "Upgrade {{library.name}}.")+        `shouldBe` "Upgrade baikai."++  describe "renderBlueprintMigrationSystemPrompt" $ do+    it "renders identity, position, shared guidance, edge instructions, and reference access" $ do+      let edge = migrationWithPrompt "1.0.0" "2.0.0" "Upgrade {{library.name}} now."+          rendered =+            renderBlueprintMigrationSystemPrompt+              "{{blueprint_name}} {{blueprint_version}} | {{migration_position}}/{{migration_total}} | {{migration_from}} -> {{migration_to}} | {{shared_prompt}} | {{migration_prompt}} | {{reference_files_dir}} | {{cwd}}"+              sampleContext+              samplePrepared+              1+              2+              edge+      rendered+        `shouldBe` "payments 4.2.0 | 1/2 | 1.0.0 -> 2.0.0 | Shared guidance for baikai. | Upgrade baikai now. | mounted at /tmp/payments/files | /tmp/project"++    it "delimits debug prompts in pending order without any execution callback" $ do+      let output =+            formatBlueprintMigrationDebugOutput+              (\position total edge -> "prompt " <> tshow position <> "/" <> tshow total <> " " <> edge.from)+              [first, second]+      output `shouldSatisfy` T.isInfixOf "===== [1/2] 1.0.0 -> 2.0.0 ====="+      output `shouldSatisfy` T.isInfixOf "===== [2/2] 2.0.0 -> 3.0.0 ====="+      T.breakOn "2.0.0 -> 3.0.0" output `shouldSatisfy` (not . T.null . snd)++  describe "runBlueprintMigrationsWith" $ do+    it "reports no work without invoking either callback" $ do+      calls <- newIORef ([] :: [Text])+      result <-+        runBlueprintMigrationsWith+          (\_ _ _ -> modifyIORef' calls (<> ["launch"]) >> pure (Right ()))+          (\_ -> modifyIORef' calls (<> ["record"]) >> pure (Right ()))+          []+      result `shouldBe` BlueprintMigrationNoWork+      readIORef calls `shouldReturn` []++    it "launches and records every edge sequentially" $ do+      calls <- newIORef ([] :: [Text])+      let launch position total edge = do+            modifyIORef' calls (<> ["launch " <> tshow position <> "/" <> tshow total <> " " <> edge.from])+            pure (Right ())+          record edge = do+            modifyIORef' calls (<> ["record " <> edge.from])+            pure (Right ())+      result <- runBlueprintMigrationsWith launch record [first, second]+      result `shouldBe` BlueprintMigrationComplete [first, second]+      readIORef calls+        `shouldReturn` [ "launch 1/2 1.0.0",+                         "record 1.0.0",+                         "launch 2/2 2.0.0",+                         "record 2.0.0"+                       ]++    it "records only completed edges after failure and resumes at the failed edge" $ do+      calls <- newIORef ([] :: [Text])+      recorded <- newIORef ([] :: [AppliedBlueprintMigration])+      let third = migration "3.0.0" "4.0.0"+          migrationPlan =+            BlueprintMigrationPlan+              { blueprintPlanName = "payments",+                blueprintPlanFrom = version "1.0.0",+                blueprintPlanTo = version "4.0.0",+                blueprintPlanSteps = [first, second, third]+              }+          launch _ _ edge = do+            modifyIORef' calls (<> ["launch " <> edge.from])+            pure $+              if edge == second+                then Left (BlueprintMigrationProcessFailure (ExitFailure 17))+                else Right ()+          record edge = do+            modifyIORef' calls (<> ["record " <> edge.from])+            modifyIORef' recorded (<> [receipt blueprintName edge.from edge.to])+            pure (Right ())+      result <- runBlueprintMigrationsWith launch record [first, second, third]+      result+        `shouldBe` BlueprintMigrationLaunchFailed second (BlueprintMigrationProcessFailure (ExitFailure 17))+      readIORef calls+        `shouldReturn` ["launch 1.0.0", "record 1.0.0", "launch 2.0.0"]++      savedReceipts <- readIORef recorded+      let resumed = pendingBlueprintMigrations False blueprintName savedReceipts migrationPlan+      resumed `shouldBe` [second, third]++      resumedResult <-+        runBlueprintMigrationsWith+          (\_ _ edge -> modifyIORef' calls (<> ["resume " <> edge.from]) >> pure (Right ()))+          record+          resumed+      resumedResult `shouldBe` BlueprintMigrationComplete [second, third]+      readIORef recorded `shouldReturn` map (\edge -> receipt blueprintName edge.from edge.to) [first, second, third]++    it "stops before the next launch when receipt recording fails" $ do+      calls <- newIORef ([] :: [Text])+      let launch _ _ edge = modifyIORef' calls (<> ["launch " <> edge.from]) >> pure (Right ())+          record edge = modifyIORef' calls (<> ["record " <> edge.from]) >> pure (Left "disk full")+      result <- runBlueprintMigrationsWith launch record [first, second]+      result `shouldBe` BlueprintMigrationRecordFailed first "disk full"+      readIORef calls `shouldReturn` ["launch 1.0.0", "record 1.0.0"]++blueprintName :: ModuleName+blueprintName = "payments"++first :: BlueprintMigration+first = migration "1.0.0" "2.0.0"++second :: BlueprintMigration+second = migration "2.0.0" "3.0.0"++migration :: Text -> Text -> BlueprintMigration+migration fromVersion toVersion =+  migrationWithPrompt fromVersion toVersion ("Migrate from " <> fromVersion <> " to " <> toVersion)++migrationWithPrompt :: Text -> Text -> Text -> BlueprintMigration+migrationWithPrompt fromVersion toVersion instructions =+  BlueprintMigration+    { from = fromVersion,+      to = toVersion,+      prompt = instructions+    }++plan :: [BlueprintMigration] -> BlueprintMigrationPlan+plan steps =+  BlueprintMigrationPlan+    { blueprintPlanName = "payments",+      blueprintPlanFrom = version "1.0.0",+      blueprintPlanTo = version "3.0.0",+      blueprintPlanSteps = steps+    }++receipt :: ModuleName -> Text -> Text -> AppliedBlueprintMigration+receipt name fromVersion toVersion =+  AppliedBlueprintMigration+    { name,+      blueprintVersion = Just "4.2.0",+      fromVersion,+      toVersion,+      appliedAt = read "2026-07-20 12:00:00 UTC" :: UTCTime,+      agentSessionId = Nothing+    }++version :: Text -> Version+version raw =+  case parseVersion raw of+    Just parsed -> parsed+    Nothing -> error "test version should parse"++tshow :: (Show a) => a -> Text+tshow = T.pack . show++sampleContext :: AgentContext+sampleContext =+  AgentContext+    { cwd = "/tmp/project",+      seihouInitialized = True,+      hasManifest = False,+      localModuleDhall = False,+      localModules = [],+      availableModules = []+    }++samplePrepared :: PreparedBlueprintExecution+samplePrepared =+  let declaration = VarDecl "library.name" VTText Nothing Nothing False Nothing+      resolved =+        Map.singleton+          "library.name"+          (ResolvedVar (VText "baikai") FromDefault declaration)+      blueprint =+        Blueprint+          { name = blueprintName,+            version = Just "4.2.0",+            description = Just "Payments upgrade",+            prompt = "Shared guidance for {{library.name}}.",+            vars = [declaration],+            prompts = [],+            baseModules = [],+            files = [],+            allowedTools = Nothing,+            tags = [],+            migrations = [first, second]+          }+   in PreparedBlueprintExecution+        { preparedBlueprint = blueprint,+          preparedBlueprintDir = "/tmp/payments",+          preparedResolvedVariables = resolved,+          preparedMountedFilesDir = Just "/tmp/payments/files",+          preparedReferenceFiles = "  - guide.md",+          preparedReferenceFilesAccess = "mounted at /tmp/payments/files",+          preparedSharedPrompt = "Shared guidance for baikai.",+          preparedAllowedTools = ["Read"]+        }
+ test/Seihou/CLI/CommandExecutionSpec.hs view
@@ -0,0 +1,158 @@+module Seihou.CLI.CommandExecutionSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Maybe (fromJust)+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful (runPureEff)+import Seihou.CLI.CommandExecution+import Seihou.Core.CommandFingerprint (fingerprintCommand)+import Seihou.Core.Types+import Seihou.Effect.ProcessPure (ProcessMock (..), runProcessPure)+import Seihou.Prelude+import System.Exit (ExitCode (..))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.CommandExecution" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-19T18:00:00Z"++laterTime :: UTCTime+laterTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-19T19:00:00Z"++commandOp :: Text -> Maybe FilePath -> ModuleName -> Int -> Operation+commandOp command workDir moduleName occurrence =+  RunCommandOp {command, workDir, moduleName, occurrence}++fingerprintOf :: Operation -> CommandFingerprint+fingerprintOf = fromJust . fingerprintCommand++receiptFor :: UTCTime -> Operation -> CommandReceipt+receiptFor completedAt operation@RunCommandOp {command, workDir, moduleName} =+  CommandReceipt+    { fingerprint = fingerprintOf operation,+      moduleName,+      command,+      workDir,+      completedAt+    }+receiptFor _ _ = error "receiptFor requires RunCommandOp"++successMock :: Text -> ProcessMock+successMock command =+  ProcessMock+    { mockCommand = "sh",+      mockArgs = ["-c", command],+      mockResult = (ExitSuccess, "output", "")+    }++spec :: Spec+spec = do+  describe "planCommands" $ do+    it "preserves command order and ignores non-command operations" $ do+      let first = commandOp "echo first" Nothing "app" 0+          second = commandOp "echo second" Nothing "app" 0+          plan = planCommands RunAllCommands Map.empty [first, WriteFileOp "file" "content" Template, second]+      map (.operation) plan.commands `shouldBe` [first, second]+      map (.disposition) plan.commands `shouldBe` [CommandWillRun, CommandWillRun]++    it "skips only fingerprints with successful prior receipts in changed-only mode" $ do+      let unchanged = commandOp "echo same" Nothing "app" 0+          changed = commandOp "echo changed" Nothing "app" 0+          prior = Map.singleton (fingerprintOf unchanged) (receiptFor fixedTime unchanged)+          plan = planCommands RunChangedCommands prior [unchanged, changed]+      map (.disposition) plan.commands+        `shouldBe` [CommandSkippedUnchanged, CommandWillRun]+      summarizeCommandPlan plan+        `shouldBe` CommandPlanSummary {willRun = 1, skippedUnchanged = 1, skippedDisabled = 0}++    it "runs duplicate declarations independently because occurrences differ" $ do+      let first = commandOp "echo same" Nothing "app" 0+          second = commandOp "echo same" Nothing "app" 1+          prior = Map.singleton (fingerprintOf first) (receiptFor fixedTime first)+          plan = planCommands RunChangedCommands prior [first, second]+      map (.disposition) plan.commands+        `shouldBe` [CommandSkippedUnchanged, CommandWillRun]++    it "marks every command disabled without minting receipts" $ do+      let operations = [commandOp "echo one" Nothing "app" 0, commandOp "echo two" Nothing "app" 0]+          plan = planCommands DisableCommands Map.empty operations+      map (.disposition) plan.commands+        `shouldBe` [CommandSkippedDisabled, CommandSkippedDisabled]++  describe "executeCommandPlan" $ do+    it "executes runnable commands in order and returns successful receipts" $ do+      let first = commandOp "echo first" Nothing "app" 0+          second = commandOp "echo second" (Just "subdir") "app" 0+          plan = planCommands RunAllCommands Map.empty [first, second]+          result =+            runPureEff $+              runProcessPure [successMock "echo first", successMock "echo second"] $+                executeCommandPlan laterTime plan+      case result of+        Right receipts -> do+          map (.fingerprint) receipts `shouldBe` map fingerprintOf [first, second]+          map (.completedAt) receipts `shouldBe` [laterTime, laterTime]+        Left err -> expectationFailure ("Expected success, got: " <> show err)++    it "does not execute skipped commands" $ do+      let operation = commandOp "echo skipped" Nothing "app" 0+          priorReceipt = receiptFor fixedTime operation+          prior = Map.singleton priorReceipt.fingerprint priorReceipt+          plan = planCommands RunChangedCommands prior [operation]+          result = runPureEff $ runProcessPure [] $ executeCommandPlan laterTime plan+      result `shouldBe` Right []++    it "returns a structured error at the first failure" $ do+      let failing = commandOp "exit 7" Nothing "app" 0+          neverReached = commandOp "echo later" Nothing "app" 0+          plan = planCommands RunAllCommands Map.empty [failing, neverReached]+          mocks =+            [ ProcessMock+                { mockCommand = "sh",+                  mockArgs = ["-c", "exit 7"],+                  mockResult = (ExitFailure 7, "partial", "boom")+                },+              successMock "echo later"+            ]+          result = runPureEff $ runProcessPure mocks $ executeCommandPlan laterTime plan+      case result of+        Left err -> do+          err.exitCode `shouldBe` 7+          err.stdout `shouldBe` "partial"+          err.stderr `shouldBe` "boom"+          err.command.operation `shouldBe` failing+        Right receipts -> expectationFailure ("Expected failure, got receipts: " <> show receipts)++  describe "finalizeCommandReceipts" $ do+    it "keeps fresh successes and unchanged receipts while dropping removed commands" $ do+      let unchanged = commandOp "echo unchanged" Nothing "app" 0+          changed = commandOp "echo changed" Nothing "app" 0+          removed = commandOp "echo removed" Nothing "app" 0+          oldUnchanged = receiptFor fixedTime unchanged+          oldRemoved = receiptFor fixedTime removed+          newChanged = receiptFor laterTime changed+          prior =+            Map.fromList+              [ (oldUnchanged.fingerprint, oldUnchanged),+                (oldRemoved.fingerprint, oldRemoved)+              ]+          plan = planCommands RunChangedCommands prior [unchanged, changed]+          finalized = finalizeCommandReceipts plan [newChanged] prior+      finalized+        `shouldBe` Map.fromList+          [ (oldUnchanged.fingerprint, oldUnchanged),+            (newChanged.fingerprint, newChanged)+          ]++    it "retains only matching old receipts when commands are disabled" $ do+      let old = commandOp "echo old" Nothing "app" 0+          new = commandOp "echo new" Nothing "app" 0+          oldReceipt = receiptFor fixedTime old+          prior = Map.singleton oldReceipt.fingerprint oldReceipt+          plan = planCommands DisableCommands prior [old, new]+      finalizeCommandReceipts plan [] prior+        `shouldBe` Map.singleton oldReceipt.fingerprint oldReceipt
test/Seihou/CLI/MigrateSpec.hs view
@@ -129,7 +129,9 @@                 { hash = hashContent content,                   moduleName = modName,                   strategy = Template,-                  generatedAt = fixedTime+                  generatedAt = fixedTime,+                  baseline = Nothing,+                  applicationIds = mempty                 }             )           | (path, content) <- entries@@ -269,7 +271,9 @@                 { hash = hashContent content,                   moduleName = ModuleName fix.modName,                   strategy = Template,-                  generatedAt = fixedTime+                  generatedAt = fixedTime,+                  baseline = Nothing,+                  applicationIds = mempty                 }             )           | (path, content) <- entries
test/Seihou/CLI/StatusSpec.hs view
@@ -15,10 +15,16 @@     MigrationPlan (..),   ) import Seihou.Core.Types-  ( AppliedBlueprint (..),+  ( ApplicationId (..),+    AppliedBlueprint (..),+    AppliedBlueprintMigration (..),+    AppliedComposition (..),+    AppliedInstanceState (..),     AppliedModule (..),+    AppliedTarget (..),     Manifest (..),     ModuleName (..),+    RecipeName (..),     emptyParentVars,   ) import Seihou.Core.Version qualified@@ -56,6 +62,30 @@       files = Map.empty     } +mkApplication :: Text -> [Text] -> AppliedComposition+mkApplication target modules =+  AppliedComposition+    { applicationId = ApplicationId ("app-" <> target),+      target = AppliedRecipeTarget (RecipeName target),+      targetSource = "/installed/" <> T.unpack target,+      targetVersion = Just "1.0.0",+      additionalModules = [],+      namespace = Nothing,+      context = Nothing,+      instances = map mkInstance modules,+      commandReceipts = Map.empty,+      appliedAt = fixedTime+    }+  where+    mkInstance name =+      AppliedInstanceState+        { name = ModuleName name,+          parentVars = emptyParentVars,+          source = "/installed/" <> T.unpack name,+          moduleVersion = Just "1.0.0",+          resolvedVars = Map.empty+        }+ -- | Build a 'MigrationPlan' fixture for use with formatStatus. mkPlan :: Text -> Text -> Text -> Int -> MigrationPlan mkPlan modName from to nSteps =@@ -101,6 +131,17 @@ withManifestBlueprint :: Maybe AppliedBlueprint -> Manifest -> Manifest withManifestBlueprint mb m = m {blueprint = mb} +mkBlueprintMigrationReceipt :: Text -> Maybe Text -> Text -> Text -> AppliedBlueprintMigration+mkBlueprintMigrationReceipt blueprintName artifactVersion fromVersion toVersion =+  AppliedBlueprintMigration+    { name = ModuleName blueprintName,+      blueprintVersion = artifactVersion,+      fromVersion = fromVersion,+      toVersion = toVersion,+      appliedAt = fixedTime,+      agentSessionId = Nothing+    }+ spec :: Spec spec = describe "formatStatus" $ do   describe "blueprint provenance" $ do@@ -165,6 +206,19 @@       out `shouldSatisfy` T.isInfixOf "Blueprint: pure-prompt (applied"       out `shouldSatisfy` T.isInfixOf "  Baseline: (none declared)" +  describe "blueprint migration receipts" $ do+    it "omits the section for an empty ledger" $ do+      let out = formatStatus False (mkManifest []) [] Nothing []+      out `shouldNotSatisfy` T.isInfixOf "Blueprint migrations:"++    it "renders blueprint name, artifact version, exact edge, and timestamp" $ do+      let receipt = mkBlueprintMigrationReceipt "payments" (Just "0.4.0") "1.0.0" "2.0.0"+          manifest = (mkManifest []) {blueprintMigrations = [receipt]}+          out = formatStatus False manifest [] Nothing []+      out `shouldSatisfy` T.isInfixOf "Blueprint migrations:"+      out `shouldSatisfy` T.isInfixOf "payments v0.4.0: 1.0.0 -> 2.0.0"+      out `shouldSatisfy` T.isInfixOf "2026-04-15 10:00 UTC"+   it "all modules clean: no remediation, no Recommended actions block" $ do     let am = mkApplied "demo" (Just "1.0.0")         manifest = mkManifest [am]@@ -176,29 +230,29 @@     out `shouldNotSatisfy` T.isInfixOf "Recommended actions"     out `shouldNotSatisfy` T.isInfixOf "Pending migration" -  it "outdated only (no migration declared): per-row upgrade hint and summary entry" $ do+  it "outdated only recommends the project-aware update workflow" $ do     let am = mkApplied "demo" (Just "0.1.0")         manifest = mkManifest [am]         entries = Just [mkEntry "demo" (Just "0.1.0") (Just "0.3.0") OutdatedSt]         out = formatStatus False manifest [] entries []     out `shouldSatisfy` T.isInfixOf "outdated: 0.3.0 available"-    out `shouldSatisfy` T.isInfixOf "Run: seihou upgrade demo"+    out `shouldSatisfy` T.isInfixOf "Run: seihou update demo"     out `shouldSatisfy` T.isInfixOf "Recommended actions:"-    out `shouldSatisfy` T.isInfixOf "  seihou upgrade demo"+    out `shouldSatisfy` T.isInfixOf "  seihou update demo"     out `shouldNotSatisfy` T.isInfixOf "Pending migration" -  it "pending migration (full chain): per-row migrate hint and summary" $ do+  it "pending migration keeps detail and recommends update" $ do     let am = mkApplied "demo" (Just "1.0.0")         manifest = mkManifest [am]         plan = mkPlan "demo" "1.0.0" "2.0.0" 1         out = formatStatus False manifest [] Nothing [(ModuleName "demo", plan)]     out `shouldSatisfy` T.isInfixOf "Pending migration: 1.0.0 -> 2.0.0 (1 step(s))"-    out `shouldSatisfy` T.isInfixOf "Run: seihou migrate demo"+    out `shouldSatisfy` T.isInfixOf "Run: seihou update demo"     out `shouldSatisfy` T.isInfixOf "Recommended actions:"-    out `shouldSatisfy` T.isInfixOf "  seihou migrate demo"+    out `shouldSatisfy` T.isInfixOf "  seihou update demo"     out `shouldNotSatisfy` T.isInfixOf "seihou upgrade" -  it "outdated + pending migration: single migrate hint, no upgrade hint" $ do+  it "outdated plus pending migration produces one update hint" $ do     let am = mkApplied "demo" (Just "0.1.0")         manifest = mkManifest [am]         plan = mkPlan "demo" "0.1.0" "0.3.0" 6@@ -206,15 +260,15 @@         out = formatStatus False manifest [] entries [(ModuleName "demo", plan)]     out `shouldSatisfy` T.isInfixOf "outdated: 0.3.0 available"     out `shouldSatisfy` T.isInfixOf "Pending migration: 0.1.0 -> 0.3.0 (6 step(s))"-    out `shouldSatisfy` T.isInfixOf "Run: seihou migrate demo"+    out `shouldSatisfy` T.isInfixOf "Run: seihou update demo"     out `shouldNotSatisfy` T.isInfixOf "seihou upgrade demo"     out `shouldSatisfy` T.isInfixOf "Recommended actions:"-    out `shouldSatisfy` T.isInfixOf "  seihou migrate demo"+    out `shouldSatisfy` T.isInfixOf "  seihou update demo"    -- Master-plan live-tree fixture: manifest=0.1.0, installed=0.3.0,   -- declared [0.1.0 → 0.2.0]. The chain reaches 0.2 via ops; the   -- supplied target is 0.3, so planTo = 0.3. Status surfaces the-  -- single in-window step and points at `seihou migrate demo` as the+  -- single in-window step and points at `seihou update demo` as the   -- remediation.   it "partial-cover plan: chain reaches an intermediate version, target is the user's installed copy" $ do     let am = mkApplied "demo" (Just "0.1.0")@@ -222,9 +276,9 @@         plan = mkPlan "demo" "0.1.0" "0.3.0" 1         out = formatStatus False manifest [] Nothing [(ModuleName "demo", plan)]     out `shouldSatisfy` T.isInfixOf "Pending migration: 0.1.0 -> 0.3.0 (1 step(s))"-    out `shouldSatisfy` T.isInfixOf "Run: seihou migrate demo"+    out `shouldSatisfy` T.isInfixOf "Run: seihou update demo"     out `shouldSatisfy` T.isInfixOf "Recommended actions:"-    out `shouldSatisfy` T.isInfixOf "  seihou migrate demo"+    out `shouldSatisfy` T.isInfixOf "  seihou update demo"     -- Doomed vocabulary is gone from status output.     out `shouldNotSatisfy` T.isInfixOf "Blocked"     out `shouldNotSatisfy` T.isInfixOf "no migration declared from"@@ -246,10 +300,49 @@             }         out = formatStatus False manifest [] Nothing [(ModuleName "demo", plan)]     out `shouldSatisfy` T.isInfixOf "Pending migration: 0.2.0 -> 0.3.0 (0 step(s))"-    out `shouldSatisfy` T.isInfixOf "Run: seihou migrate demo"+    out `shouldSatisfy` T.isInfixOf "Run: seihou update demo"     out `shouldSatisfy` T.isInfixOf "Recommended actions:"-    out `shouldSatisfy` T.isInfixOf "  seihou migrate demo"+    out `shouldSatisfy` T.isInfixOf "  seihou update demo"     -- The doomed vocabulary stays out of the rendered status.     out `shouldNotSatisfy` T.isInfixOf "Blocked"     out `shouldNotSatisfy` T.isInfixOf "--bump-only"     out `shouldNotSatisfy` T.isInfixOf "[blocked]"++  it "deduplicates repeated instances into one recipe application action" $ do+    let duplicate = mkApplied "demo" (Just "1.0.0")+        manifest =+          (mkManifest [duplicate, duplicate])+            { applications = [mkApplication "stack" ["demo", "demo"]]+            }+        plan = mkPlan "demo" "1.0.0" "2.0.0" 1+        out = formatStatus False manifest [] Nothing [(ModuleName "demo", plan)]+        recommendationLines = filter (== "  seihou update stack") (T.lines out)+    recommendationLines `shouldBe` ["  seihou update stack"]+    T.count "seihou update stack" out `shouldBe` 1+    out `shouldNotSatisfy` T.isInfixOf "  seihou migrate demo"++  it "recommends each affected application plus the whole-project update" $ do+    let shared = mkApplied "shared" (Just "1.0.0")+        manifest =+          (mkManifest [shared])+            { applications =+                [ mkApplication "stack-one" ["shared"],+                  mkApplication "stack-two" ["shared"]+                ]+            }+        plan = mkPlan "shared" "1.0.0" "2.0.0" 1+        out = formatStatus False manifest [] Nothing [(ModuleName "shared", plan)]+        recommendationLines = dropWhile (/= "Recommended actions:") (T.lines out)+    recommendationLines+      `shouldBe` [ "Recommended actions:",+                   "  seihou update stack-one",+                   "  seihou update stack-two",+                   "  seihou update"+                 ]++  it "deduplicates legacy instances by bare module name" $ do+    let duplicate = mkApplied "demo" (Just "1.0.0")+        manifest = mkManifest [duplicate, duplicate]+        plan = mkPlan "demo" "1.0.0" "2.0.0" 1+        out = formatStatus False manifest [] Nothing [(ModuleName "demo", plan)]+    T.count "seihou update demo" out `shouldBe` 2
+ test/Seihou/CLI/UpdateE2ESpec.hs view
@@ -0,0 +1,182 @@+module Seihou.CLI.UpdateE2ESpec (tests) where++import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.UpdateSpec (UpdateFixture (..), prepareUpdateFixture)+import System.Directory (doesFileExist)+import System.Environment (getEnvironment, getExecutablePath)+import System.Exit (ExitCode (..))+import System.FilePath (takeDirectory, (</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (CreateProcess (..), callProcess, proc, readCreateProcessWithExitCode, readProcess)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Update end-to-end" spec++spec :: Spec+spec = do+  it "updates through the executable and preserves a non-overlapping user edit" $+    withSystemTempDirectory "seihou-update-executable" $ \root -> do+      fixture <- prepareUpdateFixture root+      binary <- seihouBinary+      TIO.writeFile fixture.projectFile "hello accepted by-user\nkeep\nv1\n"+      (exitCode, stdoutText, stderrText) <- runSeihou binary fixture ["update", "demo", "--json"]+      case exitCode of+        ExitSuccess -> pure ()+        ExitFailure code -> expectationFailure ("update exited " <> show code <> "\nstdout:\n" <> T.unpack stdoutText <> "\nstderr:\n" <> T.unpack stderrText)+      stdoutText `shouldSatisfy` T.isInfixOf "\"outcome\":\"applied\""+      stdoutText `shouldSatisfy` T.isInfixOf "\"skippedUnchanged\":1"+      stdoutText `shouldNotSatisfy` T.isInfixOf "Apply?"+      stderrText `shouldNotSatisfy` T.isInfixOf "Apply?"+      TIO.readFile fixture.projectFile `shouldReturn` "hello accepted by-user\nkeep\nv2\n"+      TIO.readFile (fixture.installedModule <> "/module.dhall")+        `shouldReturnSatisfy` T.isInfixOf "Some \"2.0.0\""+      doesFileExist (fixture.projectRoot <> "/command.log") `shouldReturn` False+      (statusExit, statusOut, _) <- runSeihou binary fixture ["status"]+      statusExit `shouldBe` ExitSuccess+      statusOut `shouldNotSatisfy` T.isInfixOf "seihou update demo"+      afterApply <- LBS.readFile fixture.manifestPath+      (noOpExit, noOpOut, noOpErr) <- runSeihou binary fixture ["update", "demo", "--json"]+      noOpExit `shouldBe` ExitSuccess+      noOpOut `shouldSatisfy` T.isInfixOf "\"alreadyUpToDate\":true"+      noOpOut `shouldSatisfy` T.isInfixOf "\"outcome\":\"plan\""+      noOpErr `shouldNotSatisfy` T.isInfixOf "Apply?"+      LBS.readFile fixture.manifestPath `shouldReturn` afterApply++  it "keeps project, manifest, and installed cache byte-identical for JSON dry-run" $+    withSystemTempDirectory "seihou-update-executable-dry" $ \root -> do+      fixture <- prepareUpdateFixture root+      binary <- seihouBinary+      beforeProject <- TIO.readFile fixture.projectFile+      beforeManifest <- LBS.readFile fixture.manifestPath+      beforeInstalled <- TIO.readFile (fixture.installedModule <> "/module.dhall")+      (exitCode, stdoutText, _) <- runSeihou binary fixture ["update", "--dry-run", "--json"]+      exitCode `shouldBe` ExitSuccess+      stdoutText `shouldSatisfy` T.isInfixOf "\"outcome\":\"plan\""+      TIO.readFile fixture.projectFile `shouldReturn` beforeProject+      LBS.readFile fixture.manifestPath `shouldReturn` beforeManifest+      TIO.readFile (fixture.installedModule <> "/module.dhall") `shouldReturn` beforeInstalled++  it "commits exactly the managed update paths with a requested Conventional Commit message" $+    withSystemTempDirectory "seihou-update-executable-commit" $ \root -> do+      fixture <- prepareUpdateFixture root+      binary <- seihouBinary+      callProcess "git" ["-C", fixture.projectRoot, "init", "-q"]+      callProcess "git" ["-C", fixture.projectRoot, "config", "user.name", "Seihou Test"]+      callProcess "git" ["-C", fixture.projectRoot, "config", "user.email", "test@example.com"]+      callProcess "git" ["-C", fixture.projectRoot, "add", "."]+      callProcess "git" ["-C", fixture.projectRoot, "commit", "-qm", "test: record v1 fixture"]+      (exitCode, stdoutText, stderrText) <-+        runSeihou+          binary+          fixture+          ["update", "demo", "--json", "--commit-message", "chore(seihou): update demo"]+      case exitCode of+        ExitSuccess -> pure ()+        ExitFailure code -> expectationFailure ("update exited " <> show code <> "\nstdout:\n" <> T.unpack stdoutText <> "\nstderr:\n" <> T.unpack stderrText)+      subject <- T.strip . T.pack <$> readProcess "git" ["-C", fixture.projectRoot, "log", "-1", "--pretty=%s"] ""+      subject `shouldBe` "chore(seihou): update demo"+      worktree <- T.strip . T.pack <$> readProcess "git" ["-C", fixture.projectRoot, "status", "--porcelain"] ""+      worktree `shouldBe` ""++  it "retains an edited orphan under --force" $+    withSystemTempDirectory "seihou-update-executable-orphan" $ \root -> do+      fixture <- prepareUpdateFixture root+      binary <- seihouBinary+      let modulePath = fixture.remote <> "/module.dhall"+      moduleBody <- TIO.readFile modulePath+      TIO.writeFile+        modulePath+        ( T.replace+            ", steps = [{ strategy = \"template\", src = \"README.tmpl\", dest = \"README.md\", when = None Text, patch = None Text }]"+            ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }"+            moduleBody+        )+      callProcess "git" ["-C", fixture.remote, "add", "module.dhall"]+      callProcess "git" ["-C", fixture.remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "remove generated file"]+      TIO.writeFile fixture.projectFile "user-owned orphan\n"+      (exitCode, stdoutText, stderrText) <- runSeihou binary fixture ["update", "demo", "--force", "--json"]+      case exitCode of+        ExitSuccess -> pure ()+        ExitFailure code -> expectationFailure ("update exited " <> show code <> "\nstdout:\n" <> T.unpack stdoutText <> "\nstderr:\n" <> T.unpack stderrText)+      stdoutText `shouldSatisfy` T.isInfixOf "\"editedOrphans\":1"+      TIO.readFile fixture.projectFile `shouldReturn` "user-owned orphan\n"+      TIO.readFile fixture.manifestPath `shouldReturnSatisfy` T.isInfixOf "README.md"++  it "reports an unresolved overlap before publishing project, manifest, or cache state" $+    withSystemTempDirectory "seihou-update-executable-conflict" $ \root -> do+      fixture <- prepareUpdateFixture root+      binary <- seihouBinary+      TIO.writeFile (fixture.remote <> "/files/README.tmpl") "candidate {{project.name}}\nkeep\nv2\n"+      callProcess "git" ["-C", fixture.remote, "add", "files/README.tmpl"]+      callProcess "git" ["-C", fixture.remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "overlap"]+      TIO.writeFile fixture.projectFile "user accepted\nkeep\nv1\n"+      beforeManifest <- LBS.readFile fixture.manifestPath+      beforeInstalled <- LBS.readFile (fixture.installedModule <> "/module.dhall")+      (exitCode, stdoutText, _) <- runSeihou binary fixture ["update", "demo", "--json"]+      exitCode `shouldSatisfy` (/= ExitSuccess)+      stdoutText `shouldSatisfy` T.isInfixOf "\"code\":\"unresolved_conflicts\""+      TIO.readFile fixture.projectFile `shouldReturn` "user accepted\nkeep\nv1\n"+      LBS.readFile fixture.manifestPath `shouldReturn` beforeManifest+      LBS.readFile (fixture.installedModule <> "/module.dhall") `shouldReturn` beforeInstalled+      (forceExit, forceOut, forceErr) <- runSeihou binary fixture ["update", "demo", "--force", "--json"]+      case forceExit of+        ExitSuccess -> pure ()+        ExitFailure code -> expectationFailure ("forced update exited " <> show code <> "\nstdout:\n" <> T.unpack forceOut <> "\nstderr:\n" <> T.unpack forceErr)+      forceOut `shouldSatisfy` T.isInfixOf "\"outcome\":\"applied\""+      TIO.readFile fixture.projectFile `shouldReturn` "candidate accepted\nkeep\nv2\n"++  it "exposes update and its options through the shared Bash, Zsh, and Fish completion protocol" $ do+    binary <- seihouBinary+    (topExit, topOutput, _) <- runProcessText binary ["--bash-completion-enriched", "--bash-completion-index", "0"] Nothing Nothing+    topExit `shouldBe` ExitSuccess+    topOutput `shouldSatisfy` T.isInfixOf "update\tUpdate recorded project applications"+    (optionExit, optionOutput, _) <-+      runProcessText+        binary+        [ "--bash-completion-enriched",+          "--bash-completion-index",+          "2",+          "--bash-completion-word",+          "seihou",+          "--bash-completion-word",+          "update"+        ]+        Nothing+        Nothing+    optionExit `shouldBe` ExitSuccess+    optionOutput `shouldSatisfy` T.isInfixOf "--force\tUse generated content"+    (exclusiveExit, _, exclusiveErr) <-+      runProcessText binary ["update", "--run-all-commands", "--no-commands"] Nothing Nothing+    exclusiveExit `shouldSatisfy` (/= ExitSuccess)+    exclusiveErr `shouldSatisfy` T.isInfixOf "Invalid option"+    mapM_+      ( \shell -> do+          (shellExit, script, _) <- runProcessText binary ["completions", shell] Nothing Nothing+          shellExit `shouldBe` ExitSuccess+          script `shouldSatisfy` T.isInfixOf "bash-completion"+      )+      ["bash", "zsh", "fish"]++seihouBinary :: IO FilePath+seihouBinary = do+  testBinary <- getExecutablePath+  pure (takeDirectory (takeDirectory testBinary) </> "seihou" </> "seihou")++runSeihou :: FilePath -> UpdateFixture -> [String] -> IO (ExitCode, T.Text, T.Text)+runSeihou binary fixture args = do+  inherited <- getEnvironment+  let environment = ("XDG_CONFIG_HOME", fixture.xdgHome) : filter ((/= "XDG_CONFIG_HOME") . fst) inherited+  runProcessText binary args (Just fixture.projectRoot) (Just environment)++runProcessText binary args workingDirectory environment = do+  let command = (proc binary args) {cwd = workingDirectory, env = environment}+  (exitCode, stdoutText, stderrText) <- readCreateProcessWithExitCode command ""+  pure (exitCode, T.pack stdoutText, T.pack stderrText)++shouldReturnSatisfy :: IO T.Text -> (T.Text -> Bool) -> Expectation+shouldReturnSatisfy action predicate = action >>= (`shouldSatisfy` predicate)
+ test/Seihou/CLI/UpdateFixture.hs view
@@ -0,0 +1,135 @@+module Seihou.CLI.UpdateFixture+  ( minimalPlan,+    conflictPlan,+    unavailableConflictPlan,+    orphanPlan,+  )+where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Seihou.CLI.CommandExecution (CommandPlan (..), CommandPolicy (..))+import Seihou.CLI.Update+  ( InputChangeSummary (..),+    PromptPolicy (..),+    UpdatePlan (..),+    UpdateRequest (..),+    UpdateSelection (..),+  )+import Seihou.CLI.Update.Types (UpdateSnapshot (..))+import Seihou.Core.Types+  ( FileRecord (..),+    ModuleName (..),+    SHA256 (..),+    Strategy (..),+  )+import Seihou.Engine.Reconcile+  ( DesiredFile (..),+    FileReconciliation (..),+    ObservedFile (..),+    ReconciliationPlan (..),+    ReconciliationReason (..),+  )+import Seihou.Manifest.Types (emptyManifest)++fixedTime :: UTCTime+fixedTime =+  parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-19T12:00:00Z"++minimalPlan :: ReconciliationPlan -> UpdatePlan+minimalPlan reconciliation =+  UpdatePlan+    { applications = [],+      versionChanges = [],+      inputChanges = InputChangeSummary 0 0 0 0 [],+      migrations = [],+      reconciliation,+      commandPlan = CommandPlan [],+      candidateArtifacts = [],+      warnings = [],+      request =+        UpdateRequest+          { selection = AllRecordedApplications,+            varOverrides = [],+            reconfigure = False,+            promptPolicy = ForbidPrompts,+            commandPolicy = RunChangedCommands,+            dryRun = True+          },+      snapshot =+        UpdateSnapshot+          { sessionDirectory = "/tmp/session",+            projectRoot = "/tmp/project",+            manifestPath = "/tmp/project/.seihou/manifest.json",+            baselineDirectory = "/tmp/project/.seihou/baselines",+            installedDirectory = "/tmp/installed",+            originalManifest = emptyManifest fixedTime,+            candidateHashes = Map.empty,+            observedProjectHashes = Map.empty,+            transactionTargets = Set.empty+          },+      plannedApplications = []+    }++conflictPlan :: UpdatePlan+conflictPlan = minimalPlan (oneFile conflict)+  where+    conflict =+      FileConflict+        desired+        "title: user\nbody: old\n"+        "<<<<<<< current\ntitle: user\n||||||| baseline\ntitle: old\n=======\ntitle: generated\n>>>>>>> generated\n"+        OverlappingEdits+        (ObservedFile True (Just (SHA256 "current")))+        Nothing+        Nothing++unavailableConflictPlan :: UpdatePlan+unavailableConflictPlan = minimalPlan (oneFile conflict)+  where+    conflict =+      FileConflict+        desired+        "binary-current"+        "binary-current"+        (MergeDriverUnavailable "binary input")+        (ObservedFile True (Just (SHA256 "current")))+        Nothing+        Nothing++orphanPlan :: UpdatePlan+orphanPlan = minimalPlan (oneFile orphan)+  where+    orphan =+      FileOrphanEdited+        "README.md"+        FileRecord+          { hash = SHA256 "applied",+            moduleName = ModuleName "demo",+            strategy = Template,+            generatedAt = fixedTime,+            baseline = Nothing,+            applicationIds = Set.empty+          }+        "user edit"+        (ObservedFile True (Just (SHA256 "current")))+        Nothing++desired :: DesiredFile+desired =+  DesiredFile+    { path = "README.md",+      generatedContent = "title: generated\nbody: old\n",+      moduleName = ModuleName "demo",+      strategy = Template,+      applicationIds = Set.empty+    }++oneFile :: FileReconciliation -> ReconciliationPlan+oneFile reconciliation =+  ReconciliationPlan+    { applicationIds = Set.empty,+      files = Map.singleton "README.md" reconciliation,+      requiredDirectories = Set.empty+    }
+ test/Seihou/CLI/UpdateInteractionSpec.hs view
@@ -0,0 +1,67 @@+module Seihou.CLI.UpdateInteractionSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Seihou.CLI.Update (UpdatePlan (..))+import Seihou.CLI.Update.Interaction+  ( InteractionError (..),+    InteractionMode (..),+    ResolutionDecision (..),+    applyResolutionDecisions,+    forceResolveUpdatePlan,+    resolveInteractively,+  )+import Seihou.CLI.UpdateFixture (conflictPlan, orphanPlan, unavailableConflictPlan)+import Seihou.Engine.Reconcile+  ( FileConflictChoice (..),+    FileReconciliation (..),+    OrphanChoice (..),+    ReconciliationPlan (..),+    ResolvedFileConflict (..),+    unresolvedPaths,+  )+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Update.Interaction" spec++spec :: Spec+spec = do+  it "refuses unresolved plans in non-interactive mode" $ do+    result <- resolveInteractively NonInteractive conflictPlan+    result `shouldBe` Left (InteractionRequired (Set.singleton "README.md"))++  it "force accepts ordinary generated conflicts" $ do+    resolved <- expectResolved conflictPlan (forceResolveUpdatePlan conflictPlan)+    unresolvedPaths resolved.reconciliation `shouldBe` Set.empty+    case Map.lookup "README.md" resolved.reconciliation.files of+      Just (FileConflict _ _ _ _ _ _ (Just choice)) ->+        choice.choice `shouldBe` AcceptGenerated+      other -> expectationFailure ("expected resolved conflict, got " <> show other)++  it "force retains edited orphans as tracked state" $ do+    resolved <- expectResolved orphanPlan (forceResolveUpdatePlan orphanPlan)+    case Map.lookup "README.md" resolved.reconciliation.files of+      Just (FileOrphanEdited _ _ _ _ (Just choice)) ->+        choice `shouldBe` RetainTrackedOrphan+      other -> expectationFailure ("expected resolved orphan, got " <> show other)++  it "force leaves merge-driver failures unresolved" $ do+    resolved <- expectResolved unavailableConflictPlan (forceResolveUpdatePlan unavailableConflictPlan)+    unresolvedPaths resolved.reconciliation `shouldBe` Set.singleton "README.md"++  it "applies explicit keep-current and detach-orphan choices without writing" $ do+    kept <- expectResolved conflictPlan (applyResolutionDecisions [ResolveFile "README.md" KeepCurrent] conflictPlan)+    case Map.lookup "README.md" kept.reconciliation.files of+      Just (FileConflict _ _ _ _ _ _ (Just choice)) -> choice.choice `shouldBe` KeepCurrent+      other -> expectationFailure ("expected keep-current conflict resolution, got " <> show other)+    detached <- expectResolved orphanPlan (applyResolutionDecisions [ResolveOrphan "README.md" DetachAndKeepOrphan] orphanPlan)+    case Map.lookup "README.md" detached.reconciliation.files of+      Just (FileOrphanEdited _ _ _ _ (Just choice)) -> choice `shouldBe` DetachAndKeepOrphan+      other -> expectationFailure ("expected detached orphan resolution, got " <> show other)++expectResolved fallback result = case result of+  Left err -> expectationFailure (show err) >> pure fallback+  Right resolved -> pure resolved
+ test/Seihou/CLI/UpdateRenderSpec.hs view
@@ -0,0 +1,38 @@+module Seihou.CLI.UpdateRenderSpec (tests) where++import Data.List (isInfixOf)+import Data.Text qualified as T+import Seihou.CLI.Update (UpdateError (..))+import Seihou.CLI.Update.Render+  ( encodeUpdateOutput,+    errorOutput,+    planOutput,+    renderUpdateHuman,+  )+import Seihou.CLI.UpdateFixture (conflictPlan)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Update.Render" spec++spec :: Spec+spec = do+  it "groups a human plan and names unresolved paths" $ do+    let rendered = renderUpdateHuman False (planOutput conflictPlan)+    rendered `shouldSatisfy` T.isInfixOf "Files:"+    rendered `shouldSatisfy` T.isInfixOf "Conflict:    README.md"+    rendered `shouldSatisfy` T.isInfixOf "Commands:"++  it "emits one versioned JSON plan document" $ do+    let rendered = show (encodeUpdateOutput (planOutput conflictPlan))+    rendered `shouldSatisfy` isInfixOf "\\\"schemaVersion\\\":1"+    rendered `shouldSatisfy` isInfixOf "\\\"outcome\\\":\\\"plan\\\""+    rendered `shouldSatisfy` isInfixOf "\\\"classification\\\":\\\"conflict\\\""++  it "uses a stable machine error code" $ do+    let rendered = show (encodeUpdateOutput (errorOutput (UpdateManifestMissing ".seihou/manifest.json")))+    rendered `shouldSatisfy` isInfixOf "manifest_missing"+    renderUpdateHuman False (errorOutput (UpdateManifestMissing "manifest"))+      `shouldSatisfy` T.isInfixOf "Update failed [manifest_missing]"
+ test/Seihou/CLI/UpdateSpec.hs view
@@ -0,0 +1,738 @@+module Seihou.CLI.UpdateSpec+  ( tests,+    UpdateFixture (..),+    prepareUpdateFixture,+  )+where++import Control.Exception (bracket)+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, listToMaybe)+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 (..), fromGregorian)+import Seihou.CLI.CommandExecution (CommandPolicy (..))+import Seihou.CLI.Update (PromptPolicy (..), UpdateRequest (..), UpdateSelection (..), applyProjectUpdate, isUpdateNoOp, withProjectUpdate)+import Seihou.CLI.Update.Migrations (StagedMigrations (..), planAndStageMigrations)+import Seihou.CLI.Update.Selection+import Seihou.CLI.Update.Source+import Seihou.CLI.Update.Types+import Seihou.Composition.Instance (ModuleInstance (..))+import Seihou.Core.Application (mkApplicationId)+import Seihou.Core.CommandFingerprint (fingerprintCommand)+import Seihou.Core.Migration (Migration (..), MigrationOp (..))+import Seihou.Core.Types+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types (emptyManifest, manifestFromJSON, manifestToJSON)+import System.Directory (createDirectoryIfMissing, doesFileExist, withCurrentDirectory)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (callProcess)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Update" spec++spec :: Spec+spec = do+  describe "application selection" $ do+    it "selects every application containing a requested bare module" $ do+      let first = application (AppliedModuleTarget "one") [instanceState "shared" "/one/shared"]+          second = application (AppliedRecipeTarget "stack") [instanceState "shared" "/two/shared"]+          manifest :: Manifest+          manifest = manifestForApplications [first, second] Map.empty+      selectApplications (NamedUpdateTargets ["shared"]) manifest+        `shouldBe` Right (RecordedSelection [first, second])++    it "keeps manifest order for all applications and deduplicates repeated targets" $ do+      let first = application (AppliedModuleTarget "one") [instanceState "one" "/one"]+          second = application (AppliedModuleTarget "two") [instanceState "two" "/two"]+          manifest :: Manifest+          manifest = manifestForApplications [first, second] Map.empty+      selectApplications AllRecordedApplications manifest+        `shouldBe` Right (RecordedSelection [first, second])+      selectApplications (NamedUpdateTargets ["two", "two", "one"]) manifest+        `shouldBe` Right (RecordedSelection [first, second])++    it "rejects a partial selection that shares an owned path" $ do+      let first = application (AppliedModuleTarget "one") [instanceState "one" "/one"]+          second = application (AppliedModuleTarget "two") [instanceState "two" "/two"]+          owners = Set.fromList [first.applicationId, second.applicationId]+          record = FileRecord (hashContent "old") "one" Template testTime Nothing owners+          manifest :: Manifest+          manifest = manifestForApplications [first, second] (Map.singleton "shared.txt" record)+      selectApplications (NamedUpdateTargets ["one"]) manifest+        `shouldBe` Left (SharedPathRequiresApplications "shared.txt" (Set.singleton first.applicationId) (Set.singleton second.applicationId))++    it "requires one explicit target to seed a legacy manifest" $ do+      selectApplications AllRecordedApplications (emptyManifest testTime) `shouldBe` Left NoRecordedApplications+      selectApplications (NamedUpdateTargets ["one", "two"]) (emptyManifest testTime)+        `shouldBe` Left LegacyUpdateRequiresOneTarget++  describe "candidate source staging" $ do+    it "keeps local artifacts as an explicit candidate-first fallback" $+      withSystemTempDirectory "seihou-update-source" $ \root -> do+        let moduleDirectory = root </> "current" </> "demo"+            sessionDirectory = root </> "session"+            applied = application (AppliedModuleTarget "demo") [instanceState "demo" moduleDirectory]+        createDirectoryIfMissing True moduleDirectory+        TIO.writeFile (moduleDirectory </> "module.dhall") (moduleDhall "demo" "1.0.0")+        result <- stageCandidateSources sessionDirectory [applied {targetSource = moduleDirectory}]+        case result of+          Left err -> expectationFailure (show err)+          Right (catalog, warnings) -> do+            warnings `shouldContain` [LocalArtifactHasNoRemote "demo"]+            let candidate = catalog.artifacts Map.! (CandidateModule, "demo")+            candidate.originalDirectory `shouldBe` moduleDirectory+            candidate.sourceUrl `shouldBe` Nothing+            doesFileExist (catalog.searchRoot </> "demo" </> "module.dhall") `shouldReturn` True++    it "clones one registry origin once for a recipe and all of its modules" $+      withSystemTempDirectory "seihou-update-registry-source" $ \root -> do+        let remote = root </> "remote"+            installed = root </> "installed"+            moduleOne = installed </> "one"+            moduleTwo = installed </> "two"+            recipeDirectory = installed </> "stack"+            sessionDirectory = root </> "session"+            sourceUrl = T.pack remote+            applied =+              (application (AppliedRecipeTarget "stack") [instanceState "one" moduleOne, instanceState "two" moduleTwo])+                { targetSource = recipeDirectory,+                  additionalModules = []+                }+        createDirectoryIfMissing True (remote </> "modules" </> "one")+        createDirectoryIfMissing True (remote </> "modules" </> "two")+        createDirectoryIfMissing True (remote </> "recipes" </> "stack")+        TIO.writeFile (remote </> "modules" </> "one" </> "module.dhall") (moduleDhall "one" "2.0.0")+        TIO.writeFile (remote </> "modules" </> "two" </> "module.dhall") (moduleDhall "two" "2.0.0")+        TIO.writeFile (remote </> "recipes" </> "stack" </> "recipe.dhall") (recipeDhall "stack" "2.0.0" ["one", "two"])+        TIO.writeFile (remote </> "seihou-registry.dhall") registryDhall+        callProcess "git" ["-C", remote, "init", "-q"]+        callProcess "git" ["-C", remote, "add", "."]+        callProcess "git" ["-C", remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "registry"]+        mapM_ (writeOrigin sourceUrl) [moduleOne, moduleTwo, recipeDirectory]+        result <- stageCandidateSources sessionDirectory [applied]+        case result of+          Left err -> expectationFailure (show err)+          Right (catalog, _) -> do+            Map.size catalog.clonedOrigins `shouldBe` 1+            Map.keysSet catalog.artifacts+              `shouldBe` Set.fromList [(CandidateModule, "one"), (CandidateModule, "two"), (CandidateRecipe, "stack")]++    it "returns a structured clone error before touching the project" $+      withSystemTempDirectory "seihou-update-clone-error" $ \root -> do+        let moduleDirectory = root </> "installed" </> "demo"+            missingRemote = T.pack (root </> "missing-remote")+            applied = (application (AppliedModuleTarget "demo") [instanceState "demo" moduleDirectory]) {targetSource = moduleDirectory}+        writeOrigin missingRemote moduleDirectory+        result <- stageCandidateSources (root </> "session") [applied]+        result `shouldSatisfy` \case+          Left (CandidateCloneFailed url message) -> url == missingRemote && "git clone failed" `T.isInfixOf` message+          _ -> False++  describe "staged update service" $ do+    it "reuses accepted inputs, keeps dry-run read-only, and publishes one coherent update" $+      withSystemTempDirectory "seihou-update-e2e" $ \root -> do+        fixture <- prepareUpdateFixture root+        withSavedEnv "XDG_CONFIG_HOME" (Just fixture.xdgHome) $+          withCurrentDirectory fixture.projectRoot $ do+            beforeManifest <- LBS.readFile fixture.manifestPath+            beforeProject <- TIO.readFile fixture.projectFile+            beforeInstalled <- TIO.readFile (fixture.installedModule </> "module.dhall")+            let dryRequest = updateRequest True+            dryResult <- withProjectUpdate dryRequest $ \case+              Left err -> pure (Left err)+              Right plan -> applyProjectUpdate plan+            case dryResult of+              Left err -> expectationFailure (show err)+              Right _ -> pure ()+            LBS.readFile fixture.manifestPath `shouldReturn` beforeManifest+            TIO.readFile fixture.projectFile `shouldReturn` beforeProject+            TIO.readFile (fixture.installedModule </> "module.dhall") `shouldReturn` beforeInstalled++            applied <- withProjectUpdate (updateRequest False) $ \case+              Left err -> pure (Left err)+              Right plan -> applyProjectUpdate plan+            case applied of+              Left err -> expectationFailure (show err)+              Right result -> do+                result.versions `shouldSatisfy` any (\change -> change.name == "demo" && change.fromVersion == Just "1.0.0" && change.toVersion == Just "2.0.0")+                result.updatedApplications `shouldBe` [fixture.applicationId]+            TIO.readFile fixture.projectFile `shouldReturn` "hello accepted\nkeep\nv2\n"+            installedBytes <- TIO.readFile (fixture.installedModule </> "module.dhall")+            installedBytes `shouldSatisfy` T.isInfixOf "Some \"2.0.0\""+            decoded <- manifestFromJSON <$> LBS.readFile fixture.manifestPath+            case decoded of+              Left err -> expectationFailure err+              Right manifest -> case manifest.applications of+                updated : _ -> case updated.instances of+                  instanceState : _ -> do+                    instanceState.resolvedVars `shouldBe` Map.singleton "project.name" "accepted"+                    instanceState.moduleVersion `shouldBe` Just "2.0.0"+                  [] -> expectationFailure "updated application has no instances"+                [] -> expectationFailure "updated manifest has no applications"++            afterFirstApply <- LBS.readFile fixture.manifestPath+            noOp <- withProjectUpdate (updateRequest False) $ \case+              Left err -> pure (Left err)+              Right plan -> applyProjectUpdate plan+            case noOp of+              Left err -> expectationFailure (show err)+              Right result -> result.updatedApplications `shouldBe` []+            LBS.readFile fixture.manifestPath `shouldReturn` afterFirstApply++    it "rejects a plan when its manifest snapshot changes" $+      withSystemTempDirectory "seihou-update-stale" $ \root -> do+        fixture <- prepareUpdateFixture root+        withSavedEnv "XDG_CONFIG_HOME" (Just fixture.xdgHome) $+          withCurrentDirectory fixture.projectRoot $ do+            result <- withProjectUpdate (updateRequest False) $ \case+              Left err -> pure (Left err)+              Right plan -> do+                TIO.appendFile fixture.manifestPath "\n"+                applyProjectUpdate plan+            result `shouldSatisfy` \case+              Left (UpdatePlanStale paths) -> Set.member (".seihou" </> "manifest.json") paths+              _ -> False++    it "plans changed content at the same declared version with an explicit warning" $+      withSystemTempDirectory "seihou-update-same-version" $ \root -> do+        fixture <- prepareUpdateFixture root+        let modulePath = fixture.remote </> "module.dhall"+        body <- TIO.readFile modulePath+        TIO.writeFile modulePath (T.replace "Some \"2.0.0\"" "Some \"1.0.0\"" body)+        callProcess "git" ["-C", fixture.remote, "add", "module.dhall"]+        callProcess "git" ["-C", fixture.remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "same-version content change"]+        withSavedEnv "XDG_CONFIG_HOME" (Just fixture.xdgHome) $+          withCurrentDirectory fixture.projectRoot $ do+            result <- withProjectUpdate (updateRequest True) pure+            case result of+              Left err -> expectationFailure (show err)+              Right plan -> do+                isUpdateNoOp plan `shouldBe` False+                plan.versionChanges `shouldSatisfy` any (.sameVersionContentChanged)+                plan.warnings `shouldContain` [SameVersionContentChanged "demo"]++    it "re-expands a candidate recipe and removes dependencies dropped by it" $+      withSystemTempDirectory "seihou-update-recipe" $ \root -> do+        fixture <- prepareRecipeUpdateFixture root+        withSavedEnv "XDG_CONFIG_HOME" (Just fixture.recipeXdgHome) $+          withCurrentDirectory fixture.recipeProjectRoot $ do+            result <- withProjectUpdate (updateRequest False) $ \case+              Left err -> pure (Left err)+              Right plan -> applyProjectUpdate plan+            case result of+              Left err -> expectationFailure (show err)+              Right updateResult -> updateResult.updatedApplications `shouldBe` [fixture.recipeApplicationId]+            decoded <- manifestFromJSON <$> LBS.readFile fixture.recipeManifestPath+            case decoded of+              Left err -> expectationFailure err+              Right manifest -> case manifest.applications of+                [updated] -> do+                  updated.applicationId `shouldBe` fixture.recipeApplicationId+                  updated.targetVersion `shouldBe` Just "2.0.0"+                  updated.additionalModules `shouldBe` []+                  Set.fromList (map (.name) updated.instances) `shouldBe` Set.fromList ["one", "new"]+                  Set.fromList (map (.name) manifest.modules) `shouldBe` Set.fromList ["one", "new"]+                other -> expectationFailure ("expected one updated recipe application, got " <> show other)+            doesFileExist (fixture.recipeXdgHome </> "seihou" </> "installed" </> "new" </> "module.dhall") `shouldReturn` True++    it "refuses an unresolved three-way conflict without mutating durable state" $+      withSystemTempDirectory "seihou-update-conflict" $ \root -> do+        fixture <- prepareUpdateFixture root+        TIO.writeFile (fixture.remote </> "files" </> "README.tmpl") "candidate {{project.name}}\nv2\n"+        callProcess "git" ["-C", fixture.remote, "add", "files/README.tmpl"]+        callProcess "git" ["-C", fixture.remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "conflicting template"]+        withSavedEnv "XDG_CONFIG_HOME" (Just fixture.xdgHome) $+          withCurrentDirectory fixture.projectRoot $ do+            TIO.writeFile fixture.projectFile "user accepted\nv1\n"+            beforeManifest <- LBS.readFile fixture.manifestPath+            beforeInstalled <- LBS.readFile (fixture.installedModule </> "module.dhall")+            result <- withProjectUpdate (updateRequest False) $ \case+              Left err -> pure (Left err)+              Right plan -> applyProjectUpdate plan+            result `shouldSatisfy` \case+              Left (UpdateHasUnresolvedPaths paths) -> Set.member "README.md" paths+              _ -> False+            LBS.readFile fixture.manifestPath `shouldReturn` beforeManifest+            TIO.readFile fixture.projectFile `shouldReturn` "user accepted\nv1\n"+            LBS.readFile (fixture.installedModule </> "module.dhall") `shouldReturn` beforeInstalled++    it "seeds one explicit legacy target and records it only after success" $+      withSystemTempDirectory "seihou-update-legacy" $ \root -> do+        fixture <- prepareUpdateFixture root+        decoded <- manifestFromJSON <$> LBS.readFile fixture.manifestPath+        legacy <- case decoded of+          Left err -> expectationFailure err >> pure (emptyManifest testTime)+          Right manifest -> pure (withoutApplications manifest)+        LBS.writeFile fixture.manifestPath (manifestToJSON legacy)+        let request = (updateRequest False) {selection = NamedUpdateTargets ["demo"]}+        withSavedEnv "XDG_CONFIG_HOME" (Just fixture.xdgHome) $+          withCurrentDirectory fixture.projectRoot $ do+            result <- withProjectUpdate request $ \case+              Left err -> pure (Left err)+              Right plan -> applyProjectUpdate plan+            case result of+              Left err -> expectationFailure (show err)+              Right updateResult -> updateResult.updatedApplications `shouldBe` [fixture.applicationId]+            updated <- manifestFromJSON <$> LBS.readFile fixture.manifestPath+            case updated of+              Left err -> expectationFailure err+              Right manifest -> case manifest.applications of+                [applicationState] -> case applicationState.instances of+                  [moduleState] -> moduleState.resolvedVars `shouldBe` Map.singleton "project.name" "accepted"+                  other -> expectationFailure ("expected one legacy module instance, got " <> show other)+                other -> expectationFailure ("expected one seeded application, got " <> show other)++    it "rolls managed project and cache state back when a candidate command fails" $+      withSystemTempDirectory "seihou-update-command-failure" $ \root -> do+        fixture <- prepareUpdateFixture root+        let modulePath = fixture.remote </> "module.dhall"+        body <- TIO.readFile modulePath+        TIO.writeFile+          modulePath+          ( T.replace+              ", commands = [{ run = \"printf should-not-run >> command.log\", workDir = None Text, when = None Text }]"+              ", commands = [{ run = \"exit 7\", workDir = None Text, when = None Text }]"+              body+          )+        callProcess "git" ["-C", fixture.remote, "add", "module.dhall"]+        callProcess "git" ["-C", fixture.remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "failing command"]+        withSavedEnv "XDG_CONFIG_HOME" (Just fixture.xdgHome) $+          withCurrentDirectory fixture.projectRoot $ do+            beforeManifest <- LBS.readFile fixture.manifestPath+            beforeProject <- TIO.readFile fixture.projectFile+            beforeInstalled <- LBS.readFile (fixture.installedModule </> "module.dhall")+            result <- withProjectUpdate (updateRequest False) $ \case+              Left err -> pure (Left err)+              Right plan -> applyProjectUpdate plan+            result `shouldSatisfy` \case+              Left UpdateCommandFailed {} -> True+              _ -> False+            LBS.readFile fixture.manifestPath `shouldReturn` beforeManifest+            TIO.readFile fixture.projectFile `shouldReturn` beforeProject+            LBS.readFile (fixture.installedModule </> "module.dhall") `shouldReturn` beforeInstalled++    it "rolls managed state back when installed-cache publication fails" $+      withSystemTempDirectory "seihou-update-cache-failure" $ \root -> do+        fixture <- prepareUpdateFixture root+        withSavedEnv "XDG_CONFIG_HOME" (Just fixture.xdgHome) $+          withCurrentDirectory fixture.projectRoot $ do+            beforeManifest <- LBS.readFile fixture.manifestPath+            beforeProject <- TIO.readFile fixture.projectFile+            beforeInstalled <- LBS.readFile (fixture.installedModule </> "module.dhall")+            result <- withProjectUpdate (updateRequest False) $ \case+              Left err -> pure (Left err)+              Right plan -> applyProjectUpdate (breakCandidatePublication plan)+            result `shouldSatisfy` \case+              Left UpdateCachePublicationFailed {} -> True+              _ -> False+            LBS.readFile fixture.manifestPath `shouldReturn` beforeManifest+            TIO.readFile fixture.projectFile `shouldReturn` beforeProject+            LBS.readFile (fixture.installedModule </> "module.dhall") `shouldReturn` beforeInstalled++  describe "migration staging" $ do+    it "preserves parameterized instances while planning their shared transition once" $+      withSystemTempDirectory "seihou-update-shared-migration" $ \projectRoot -> do+        let parentOne = ParentVars (Map.singleton "tenant" "one")+            parentTwo = ParentVars (Map.singleton "tenant" "two")+            instanceOne = ModuleInstance "shared" parentOne+            instanceTwo = ModuleInstance "shared" parentTwo+            stateFor parent = AppliedInstanceState "shared" parent "/installed/shared" (Just "1.0.0") Map.empty+            previous = application (AppliedModuleTarget "shared") [stateFor parentOne, stateFor parentTwo]+            candidate =+              Module+                { name = "shared",+                  version = Just "2.0.0",+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = [Migration "1.0.0" "2.0.0" [RunCommand "true" Nothing]]+                }+            appliedModules =+              [ AppliedModule "shared" parentOne "/installed/shared" (Just "1.0.0") testTime Nothing,+                AppliedModule "shared" parentTwo "/installed/shared" (Just "1.0.0") testTime Nothing+              ]+            base = emptyManifest testTime+            manifest =+              Manifest+                { version = base.version,+                  genAt = base.genAt,+                  modules = appliedModules,+                  vars = Map.empty,+                  files = Map.empty,+                  applications = [previous],+                  recipe = Nothing,+                  blueprint = Nothing,+                  blueprintMigrations = []+                }+            catalog = CandidateCatalog (projectRoot </> "search") Map.empty Map.empty+            candidates = [(instanceOne, candidate, "/candidate/shared"), (instanceTwo, candidate, "/candidate/shared")]+        staged <- planAndStageMigrations projectRoot manifest catalog [(Just previous, candidates)]+        case staged of+          Left err -> expectationFailure (show err)+          Right migrationStage -> do+            length migrationStage.plans `shouldBe` 1+            migrationStage.plans `shouldSatisfy` all (.containsCommands)+            migrationStage.warnings `shouldBe` [MigrationCommandNotSimulated "shared" "true"]+            map (.moduleVersion) migrationStage.manifest.modules `shouldBe` [Just "2.0.0", Just "2.0.0"]++data UpdateFixture = UpdateFixture+  { projectRoot :: FilePath,+    projectFile :: FilePath,+    manifestPath :: FilePath,+    xdgHome :: FilePath,+    installedModule :: FilePath,+    remote :: FilePath,+    applicationId :: ApplicationId+  }++data RecipeUpdateFixture = RecipeUpdateFixture+  { recipeProjectRoot :: FilePath,+    recipeManifestPath :: FilePath,+    recipeXdgHome :: FilePath,+    recipeApplicationId :: ApplicationId+  }++prepareUpdateFixture :: FilePath -> IO UpdateFixture+prepareUpdateFixture root = do+  let projectRoot = root </> "project"+      manifestPath = projectRoot </> ".seihou" </> "manifest.json"+      projectFile = projectRoot </> "README.md"+      remote = root </> "remote"+      xdgHome = root </> "xdg"+      installedModule = xdgHome </> "seihou" </> "installed" </> "demo"+      unchangedCommand = "printf should-not-run >> command.log"+      commandOperation = RunCommandOp unchangedCommand Nothing "demo" 0+      commandFingerprint = fromMaybe (error "test fixture command fingerprint") (fingerprintCommand commandOperation)+      commandReceipt = CommandReceipt commandFingerprint "demo" unchangedCommand Nothing testTime+      baselineContent = "hello accepted\nkeep\nv1\n"+      baselineRef = BaselineRef (hashContent baselineContent)+      target = AppliedModuleTarget "demo"+      applicationId = mkApplicationId target []+      app =+        (application target [instanceState "demo" installedModule])+          { applicationId,+            targetSource = installedModule,+            targetVersion = Just "1.0.0",+            commandReceipts = Map.singleton commandFingerprint commandReceipt,+            instances =+              [ (instanceState "demo" installedModule)+                  { resolvedVars = Map.singleton "project.name" "accepted"+                  }+              ]+          }+      appliedModule = AppliedModule "demo" emptyParentVars installedModule (Just "1.0.0") testTime Nothing+      fileRecord =+        FileRecord+          (hashContent baselineContent)+          "demo"+          Template+          testTime+          (Just baselineRef)+          (Set.singleton applicationId)+      manifest =+        (emptyManifest testTime)+          { modules = [appliedModule],+            vars = Map.singleton "project.name" "accepted",+            files = Map.singleton "README.md" fileRecord,+            applications = [app]+          }+  createDirectoryIfMissing True (installedModule </> "files")+  TIO.writeFile (installedModule </> "module.dhall") (moduleDhallWithTemplate "demo" "1.0.0" "old-default")+  TIO.writeFile (installedModule </> "files" </> "README.tmpl") "hello {{project.name}}\nkeep\nv1\n"+  createDirectoryIfMissing True (remote </> "files")+  TIO.writeFile (remote </> "module.dhall") (moduleDhallWithTemplate "demo" "2.0.0" "new-default")+  TIO.writeFile (remote </> "files" </> "README.tmpl") "hello {{project.name}}\nkeep\nv2\n"+  callProcess "git" ["-C", remote, "init", "-q"]+  callProcess "git" ["-C", remote, "add", "."]+  callProcess "git" ["-C", remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "v2"]+  TIO.writeFile+    (installedModule </> ".seihou-origin.json")+    ("{\"sourceUrl\":\"" <> T.pack remote <> "\",\"version\":\"1.0.0\"}")+  createDirectoryIfMissing True (projectRoot </> ".seihou" </> "baselines")+  TIO.writeFile projectFile baselineContent+  TIO.writeFile+    (projectRoot </> ".seihou" </> "baselines" </> T.unpack baselineRef.unBaselineRef.unSHA256)+    baselineContent+  LBS.writeFile manifestPath (manifestToJSON manifest)+  pure UpdateFixture {projectRoot, projectFile, manifestPath, xdgHome, installedModule, remote, applicationId}++prepareRecipeUpdateFixture :: FilePath -> IO RecipeUpdateFixture+prepareRecipeUpdateFixture root = do+  let projectRoot = root </> "project"+      manifestPath = projectRoot </> ".seihou" </> "manifest.json"+      remote = root </> "remote"+      xdgHome = root </> "xdg"+      installedRoot = xdgHome </> "seihou" </> "installed"+      installedOne = installedRoot </> "one"+      installedOld = installedRoot </> "old"+      installedRecipe = installedRoot </> "stack"+      target = AppliedRecipeTarget "stack"+      applicationId = mkApplicationId target []+      app =+        AppliedComposition+          { applicationId,+            target,+            targetSource = installedRecipe,+            targetVersion = Just "1.0.0",+            additionalModules = [],+            namespace = Just "one",+            context = Nothing,+            instances = [instanceState "old" installedOld, instanceState "one" installedOne],+            commandReceipts = Map.empty,+            appliedAt = testTime+          }+      base = emptyManifest testTime+      manifest =+        Manifest+          { version = base.version,+            genAt = base.genAt,+            modules =+              [ AppliedModule "old" emptyParentVars installedOld (Just "1.0.0") testTime Nothing,+                AppliedModule "one" emptyParentVars installedOne (Just "1.0.0") testTime Nothing+              ],+            vars = Map.empty,+            files = Map.empty,+            applications = [app],+            recipe = Just (AppliedRecipe "stack" (Just "1.0.0") testTime),+            blueprint = Nothing,+            blueprintMigrations = []+          }+      sourceUrl = T.pack remote+  createDirectoryIfMissing True installedOne+  createDirectoryIfMissing True installedOld+  createDirectoryIfMissing True installedRecipe+  TIO.writeFile (installedOne </> "module.dhall") (moduleDhall "one" "1.0.0")+  TIO.writeFile (installedOld </> "module.dhall") (moduleDhall "old" "1.0.0")+  TIO.writeFile (installedRecipe </> "recipe.dhall") (recipeDhall "stack" "1.0.0" ["one", "old"])+  mapM_ (writeOrigin sourceUrl) [installedOne, installedOld, installedRecipe]+  createDirectoryIfMissing True (remote </> "modules" </> "one")+  createDirectoryIfMissing True (remote </> "modules" </> "old")+  createDirectoryIfMissing True (remote </> "modules" </> "new")+  createDirectoryIfMissing True (remote </> "recipes" </> "stack")+  TIO.writeFile (remote </> "modules" </> "one" </> "module.dhall") (moduleDhall "one" "2.0.0")+  TIO.writeFile (remote </> "modules" </> "old" </> "module.dhall") (moduleDhall "old" "1.0.0")+  TIO.writeFile (remote </> "modules" </> "new" </> "module.dhall") (moduleDhall "new" "1.0.0")+  TIO.writeFile (remote </> "recipes" </> "stack" </> "recipe.dhall") (recipeDhall "stack" "2.0.0" ["one", "new"])+  TIO.writeFile (remote </> "seihou-registry.dhall") recipeUpdateRegistryDhall+  callProcess "git" ["-C", remote, "init", "-q"]+  callProcess "git" ["-C", remote, "add", "."]+  callProcess "git" ["-C", remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "recipe v2"]+  createDirectoryIfMissing True (projectRoot </> ".seihou")+  LBS.writeFile manifestPath (manifestToJSON manifest)+  pure+    RecipeUpdateFixture+      { recipeProjectRoot = projectRoot,+        recipeManifestPath = manifestPath,+        recipeXdgHome = xdgHome,+        recipeApplicationId = applicationId+      }++updateRequest :: Bool -> UpdateRequest+updateRequest dryRun =+  UpdateRequest+    { selection = AllRecordedApplications,+      varOverrides = [],+      reconfigure = False,+      promptPolicy = ForbidPrompts,+      commandPolicy = RunChangedCommands,+      dryRun+    }++moduleDhallWithTemplate :: Text -> Text -> Text -> Text+moduleDhallWithTemplate name version defaultValue =+  T.unlines+    [ "{ name = \"" <> name <> "\"",+      ", version = Some \"" <> version <> "\"",+      ", description = None Text",+      ", vars = [{ name = \"project.name\", type = \"text\", default = Some \"" <> defaultValue <> "\", description = None Text, required = False, validation = None Text }]",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", steps = [{ strategy = \"template\", src = \"README.tmpl\", dest = \"README.md\", when = None Text, patch = None Text }]",+      ", commands = [{ run = \"printf should-not-run >> command.log\", workDir = None Text, when = None Text }]",+      ", dependencies = [] : List Text",+      ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+      "}"+    ]++withSavedEnv :: String -> Maybe String -> IO a -> IO a+withSavedEnv key value action =+  bracket+    (lookupEnv key <* setValue value)+    setValue+    (const action)+  where+    setValue (Just current) = setEnv key current+    setValue Nothing = unsetEnv key++application :: AppliedTarget -> [AppliedInstanceState] -> AppliedComposition+application target instances =+  AppliedComposition+    { applicationId = mkApplicationId target [],+      target,+      targetSource = maybe "" (.source) (listToMaybe instances),+      targetVersion = Just "1.0.0",+      additionalModules = [],+      namespace = Nothing,+      context = Nothing,+      instances,+      commandReceipts = Map.empty,+      appliedAt = testTime+    }++instanceState :: ModuleName -> FilePath -> AppliedInstanceState+instanceState name source =+  AppliedInstanceState+    { name,+      parentVars = emptyParentVars,+      source,+      moduleVersion = Just "1.0.0",+      resolvedVars = Map.empty+    }++moduleDhall :: Text -> Text -> Text+moduleDhall name version =+  T.unlines+    [ "{ name = \"" <> name <> "\"",+      ", version = Some \"" <> version <> "\"",+      ", description = None Text",+      ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+      ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+      ", dependencies = [] : List Text",+      ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+      "}"+    ]++recipeDhall :: Text -> Text -> [Text] -> Text+recipeDhall name version modules =+  T.unlines+    [ "{ name = \"" <> name <> "\"",+      ", version = Some \"" <> version <> "\"",+      ", description = None Text",+      ", modules = ["+        <> T.intercalate+          ", "+          [ "{ module = \"" <> moduleName <> "\", vars = [] : List { name : Text, value : Text } }"+          | moduleName <- modules+          ]+        <> "]",+      ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      "}"+    ]++registryDhall :: Text+registryDhall =+  T.unlines+    [ "{ repoName = \"update-test\"",+      ", repoDescription = None Text",+      ", modules =",+      "  [ { name = \"one\", version = Some \"2.0.0\", path = \"modules/one\", description = None Text, tags = [] : List Text }",+      "  , { name = \"two\", version = Some \"2.0.0\", path = \"modules/two\", description = None Text, tags = [] : List Text }",+      "  ]",+      ", recipes = [{ name = \"stack\", version = Some \"2.0.0\", path = \"recipes/stack\", description = None Text, tags = [] : List Text }]",+      ", blueprints = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+      ", prompts = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+      "}"+    ]++recipeUpdateRegistryDhall :: Text+recipeUpdateRegistryDhall =+  T.unlines+    [ "{ repoName = \"recipe-update-test\"",+      ", repoDescription = None Text",+      ", modules =",+      "  [ { name = \"one\", version = Some \"2.0.0\", path = \"modules/one\", description = None Text, tags = [] : List Text }",+      "  , { name = \"old\", version = Some \"1.0.0\", path = \"modules/old\", description = None Text, tags = [] : List Text }",+      "  , { name = \"new\", version = Some \"1.0.0\", path = \"modules/new\", description = None Text, tags = [] : List Text }",+      "  ]",+      ", recipes = [{ name = \"stack\", version = Some \"2.0.0\", path = \"recipes/stack\", description = None Text, tags = [] : List Text }]",+      ", blueprints = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+      ", prompts = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+      "}"+    ]++writeOrigin :: Text -> FilePath -> IO ()+writeOrigin sourceUrl directory = do+  createDirectoryIfMissing True directory+  TIO.writeFile (directory </> ".seihou-origin.json") ("{\"sourceUrl\":\"" <> sourceUrl <> "\"}")++manifestForApplications :: [AppliedComposition] -> Map.Map FilePath FileRecord -> Manifest+manifestForApplications applicationRecords fileRecords =+  let base = emptyManifest testTime+   in Manifest+        { version = base.version,+          genAt = base.genAt,+          modules = base.modules,+          vars = base.vars,+          files = fileRecords,+          applications = applicationRecords,+          recipe = base.recipe,+          blueprint = base.blueprint,+          blueprintMigrations = base.blueprintMigrations+        }++breakCandidatePublication :: UpdatePlan -> UpdatePlan+breakCandidatePublication plan =+  UpdatePlan+    { applications = plan.applications,+      versionChanges = plan.versionChanges,+      inputChanges = plan.inputChanges,+      migrations = plan.migrations,+      reconciliation = plan.reconciliation,+      commandPlan = plan.commandPlan,+      candidateArtifacts = map breakArtifact plan.candidateArtifacts,+      warnings = plan.warnings,+      request = plan.request,+      snapshot = plan.snapshot,+      plannedApplications = plan.plannedApplications+    }+  where+    breakArtifact artifact =+      CandidateArtifact+        { kind = artifact.kind,+          name = artifact.name,+          version = artifact.version,+          originalDirectory = plan.snapshot.sessionDirectory </> "missing-publication-source",+          sourceDirectory = artifact.sourceDirectory,+          sourceUrl = artifact.sourceUrl,+          repoName = artifact.repoName,+          tags = artifact.tags,+          sourceRevision = artifact.sourceRevision,+          contentHash = artifact.contentHash,+          moduleDefinition = artifact.moduleDefinition,+          recipeDefinition = artifact.recipeDefinition+        }++withoutApplications :: Manifest -> Manifest+withoutApplications manifest =+  Manifest+    { version = manifest.version,+      genAt = manifest.genAt,+      modules = manifest.modules,+      vars = manifest.vars,+      files = manifest.files,+      applications = [],+      recipe = manifest.recipe,+      blueprint = manifest.blueprint,+      blueprintMigrations = manifest.blueprintMigrations+    }++testTime :: UTCTime+testTime = UTCTime (fromGregorian 2026 7 19) 0