diff --git a/data/assist-prompt.md b/data/assist-prompt.md --- a/data/assist-prompt.md +++ b/data/assist-prompt.md @@ -19,122 +19,7 @@ {{available_modules}} -## Module Schema Reference - -A Seihou module is a directory containing a `module.dhall` file and a `files/` subdirectory. -Module names must match `[a-z][a-z0-9-]*`. - -### module.dhall format - -```dhall -{ name = "my-module" -, description = Some "What this module does" -, vars = - [ { name = "project.name" - , type = "text" -- text | bool | int | list | choice - , default = None Text -- or Some "value" - , description = Some "Description" - , required = True - , validation = None Text -- or Some "[a-z][a-z0-9-]*" (regex) - } - ] -, exports = [] : List { var : Text, alias : Optional Text } -, prompts = - [ { var = "project.name" - , text = "What is your project name?" - , when = None Text -- or Some "IsSet variable" or Some "Eq var value" - , choices = None (List Text) -- or Some ["opt1", "opt2"] - } - ] -, steps = - [ { strategy = "template" -- copy | template | dhall-text | structured - , src = "README.md.tpl" -- relative to files/ - , dest = "README.md" -- output path, supports \{{var}} in path - , when = None Text - , patch = None Text -- append-file | prepend-file | append-section | append-line-if-absent | replace-section - } - ] -, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text } -, dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } } -, migrations = [] : List Migration.Type -, removal = None Removal.Type -} -``` - -### Module removal - -Declare a `removal` section to make a module removable via `seihou remove `. The removal section lists steps that reverse the module's effects: - -```dhall -, removal = Some - { steps = - [ { action = "remove-file", path = "README.md", content = None Text } - , { action = "remove-section", path = ".gitignore", content = None Text } - ] - } -``` - -Actions: `remove-file` (delete a file), `remove-section` (strip tagged section markers), `rewrite-file` (transform file content). If `removal = None Removal.Type`, the module cannot be removed. - -### Migrations - -Declare `migrations` to move a consumer's project files between module versions. Each entry has a `from` version, a `to` version, and an ordered `ops` list. The planner picks a contiguous chain (no graph search, no skipping); duplicate `from` edges or jumps past the target are rejected. - -```dhall -, migrations = - [ S.Migration::{ from = "1.0.0" - , to = "2.0.0" - , ops = - [ S.MigrationOp.MoveDir { src = "app", dest = "src" } - , S.MigrationOp.DeleteFile { path = "Setup.hs" } - ] - } - ] -``` - -Operations: `MoveFile { src, dest }`, `MoveDir { src, dest }`, `DeleteFile { path }`, `DeleteDir { path }`, `RunCommand { run, workDir : Optional Text }`. Moves rewrite the manifest's `files` map keys. Conflicts mirror `seihou remove` — Safe / Conflict / Gone — and `--force` is required to overwrite user-edited files. - -Add migrations only when a new module version changes file *layout* (renames, deletions). Content-only changes don't need migrations; re-running `seihou run` already updates content. See `seihou help migrations` for full detail. - -### Dependencies - -Dependencies use the record form `{ module, vars }`. For simple deps without variable bindings: - dependencies = [ { module = "nix-base", vars = [] : List { name : Text, value : Text } } ] - -For parameterized deps that supply values to the child module: - dependencies = [ { module = "nix-flake", vars = [ { name = "nix.system", value = "x86_64-linux" } ] } ] - -### Schema package and record completion - -Seihou publishes its Dhall schema at `github.com/shinzui/seihou-schema`. Modules import it via a pinned HTTPS URL with an integrity hash and use record completion (`::`) for concise authoring: -```dhall -let S = - https://raw.githubusercontent.com/shinzui/seihou-schema//package.dhall - sha256: - -in S.Module::{ - , name = "my-module" - , steps = [ S.Step::{ strategy = "template", src = "foo.tpl", dest = "foo" } ] - , dependencies = [ S.Dependency::{ module = "nix-base" } ] - } -``` -Running `seihou new-module` generates modules in this format automatically. -Available types: S.Module, S.Step, S.VarDecl, S.VarExport, S.Prompt, S.Command, S.Dependency, S.Migration, S.MigrationOp. - -### Empty list type annotations - -Dhall requires type annotations on empty lists. Common patterns: - exports = [] : List { var : Text, alias : Optional Text } - commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text } - dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } } - -### Variable types - -- text: String value -- bool: true/false/yes/no/1/0 -- int: Integer -- list: Comma-separated values -- choice: Must match one of the prompt's choices list +{{module_reference}} ### Blueprints and prompts @@ -177,7 +62,18 @@ - **template**: Replaces `\{{var}}` placeholders with values (most common) - **dhall-text**: Replaces placeholders, then evaluates as Dhall expression to Text - **structured**: Replaces placeholders, evaluates Dhall to record, serializes to JSON/YAML +- **symlink** with checkout lifecycle: declares an ignored project directory link (see Module Schema Reference) +### File ownership + +Choose lifecycle independently of rendering strategy. Use `lifecycle = Some "seed"` +for project-authored starters such as source stubs, Cabal files and changelogs; +keep policy/configuration that producers maintain managed. Seeds support only +whole-file copy/template/dhall-text without patches. Verify first run, pre-existing +files, forced reruns, deliberate deletion and ordinary update adoption. Do not add +migration/removal shell that rewrites or deletes seeds. Require Seihou 0.11.0.0+ +when publishing seed producers; older clients can ignore lifecycle. + ### Conditional expressions (when field) - `IsSet variable.name` — true if variable has a value - `Eq variable.name value` — true if variable equals value @@ -186,7 +82,6 @@ ### Composition patching (patch field) - `append-section` — wraps in section markers, appends -- `replace-section` — replaces content between existing section markers - `append-file` — appends to end without markers - `prepend-file` — prepends to beginning - `append-line-if-absent` — appends only lines not already present (idempotent, no markers) @@ -199,7 +94,7 @@ - `seihou new-module NAME` — scaffold a new module with boilerplate - `seihou new-blueprint NAME [--path DIR]` — scaffold a new blueprint (agent-driven) - `seihou new-prompt NAME [--path DIR]` — scaffold a reusable agent-session prompt -- `seihou validate-module [PATH]` — validate module.dhall (9 checks) +- `seihou validate-module [PATH]` — validate module.dhall - `seihou validate-blueprint [PATH]` — validate blueprint.dhall - `seihou validate-prompt [PATH]` — validate prompt.dhall - `seihou prompt run PROMPT [--debug] [--var K=V]` — render and launch a reusable prompt @@ -207,6 +102,9 @@ - `seihou run MODULE --dry-run [--var K=V]` — preview generation without writing - `seihou run MODULE [--var K=V]` — generate project - `seihou list` — list all available modules, recipes, blueprints, and prompts +- `seihou update [TARGET] [--dry-run]` — update recorded applications and preserve user edits +- `seihou sync [--dry-run]` — restore recorded links and execute declared repeatable checkout commands +- `seihou help` — discover conceptual help; use `seihou COMMAND --help` for flags - `seihou status` — show manifest state - `seihou diff` — compare manifest vs disk - `seihou config set|get|unset|list KEY [VALUE] [--global]` — manage config diff --git a/data/blueprint-migration-prompt.md b/data/blueprint-migration-prompt.md --- a/data/blueprint-migration-prompt.md +++ b/data/blueprint-migration-prompt.md @@ -65,6 +65,8 @@ 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. + Project-owned seed source/configuration may be edited when this edge requires + it; do not rerun templates or alter seed receipts to erase authored changes. 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. diff --git a/data/blueprint-prompt.md b/data/blueprint-prompt.md --- a/data/blueprint-prompt.md +++ b/data/blueprint-prompt.md @@ -57,9 +57,14 @@ when it is available; otherwise ask the user to paste the relevant file. 2. **Examine the baseline.** If the Baseline section above lists applied - modules, the project already contains files generated from them. Suggest - `seihou status` and `git status`, and ask the user for key file contents - when the requested change depends on them. + modules, the project already contains files generated from them. Inspect + `seihou status`, `git status` and relevant files when tools are available; + otherwise ask for the needed output. Preserve user changes and declared + checkout links; fresh clones restore those with `seihou sync`. Baseline seeds + are project-owned starters: edit them as the task requires, preserve existing + authored content, and do not regenerate them to remove drift. Status/diff + count seed receipts without comparing their content. Deliberate deletion stays + deleted, including on forced baseline reruns. 3. **Draft.** Provide exact paths and complete content for new files, and patch-style snippets for modifications. Prefer additive changes: leave @@ -73,7 +78,7 @@ 5. **Commit.** Suggest `git add` and `git commit` commands to record the work. Reference the blueprint name in the commit message: - "Apply blueprint {{blueprint_name}} for ". + "chore(seihou): apply blueprint {{blueprint_name}} for ". ## Response Guidelines diff --git a/data/bootstrap-prompt.md b/data/bootstrap-prompt.md --- a/data/bootstrap-prompt.md +++ b/data/bootstrap-prompt.md @@ -21,122 +21,7 @@ {{available_modules}} -## Module Schema Reference - -A Seihou module is a directory containing a `module.dhall` file and a `files/` subdirectory. -Module names must match `[a-z][a-z0-9-]*`. - -### module.dhall format - -```dhall -{ name = "my-module" -, description = Some "What this module does" -, vars = - [ { name = "project.name" - , type = "text" -- text | bool | int | list | choice - , default = None Text -- or Some "value" - , description = Some "Description" - , required = True - , validation = None Text -- or Some "[a-z][a-z0-9-]*" (regex) - } - ] -, exports = [] : List { var : Text, alias : Optional Text } -, prompts = - [ { var = "project.name" - , text = "What is your project name?" - , when = None Text -- or Some "IsSet variable" or Some "Eq var value" - , choices = None (List Text) -- or Some ["opt1", "opt2"] - } - ] -, steps = - [ { strategy = "template" -- copy | template | dhall-text | structured - , src = "README.md.tpl" -- relative to files/ - , dest = "README.md" -- output path, supports \{{var}} in path - , when = None Text - , patch = None Text -- append-file | prepend-file | append-section | append-line-if-absent | replace-section - } - ] -, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text } -, dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } } -, migrations = [] : List Migration.Type -, removal = None Removal.Type -} -``` - -### Module removal - -Declare a `removal` section to make a module removable via `seihou remove `. The removal section lists steps that reverse the module's effects: - -```dhall -, removal = Some - { steps = - [ { action = "remove-file", path = "README.md", content = None Text } - , { action = "remove-section", path = ".gitignore", content = None Text } - ] - } -``` - -Actions: `remove-file` (delete a file), `remove-section` (strip tagged section markers), `rewrite-file` (transform file content). If `removal = None Removal.Type`, the module cannot be removed. - -### Migrations - -Declare `migrations` to move a consumer's project between module versions. Each entry has `from`, `to`, and an ordered `ops` list. The planner picks a contiguous chain (no graph search, no skipping); duplicate `from` edges or jumps past the target are rejected. - -```dhall -, migrations = - [ S.Migration::{ from = "1.0.0" - , to = "2.0.0" - , ops = - [ S.MigrationOp.MoveDir { src = "app", dest = "src" } - , S.MigrationOp.DeleteFile { path = "Setup.hs" } - ] - } - ] -``` - -Operations: `MoveFile { src, dest }`, `MoveDir { src, dest }`, `DeleteFile { path }`, `DeleteDir { path }`, `RunCommand { run, workDir : Optional Text }`. Moves rewrite the manifest's `files` map keys. Conflicts mirror `seihou remove` — Safe / Conflict / Gone — and `--force` is required to overwrite user-edited files. - -A bootstrap-time module typically starts at v1 with `migrations = [] : List Migration.Type`. Add entries only when bumping `version` in a way that changes file *layout* (renames, deletions). Content-only changes don't need migrations. See `seihou help migrations` for full detail. - -### Dependencies - -Dependencies use the record form `{ module, vars }`. For simple deps without variable bindings: - dependencies = [ { module = "nix-base", vars = [] : List { name : Text, value : Text } } ] - -For parameterized deps that supply values to the child module: - dependencies = [ { module = "nix-flake", vars = [ { name = "nix.system", value = "x86_64-linux" } ] } ] - -### Schema package and record completion - -Seihou publishes its Dhall schema at `github.com/shinzui/seihou-schema`. Modules import it via a pinned HTTPS URL with an integrity hash and use record completion (`::`) for concise authoring: -```dhall -let S = - https://raw.githubusercontent.com/shinzui/seihou-schema//package.dhall - sha256: - -in S.Module::{ - , name = "my-module" - , steps = [ S.Step::{ strategy = "template", src = "foo.tpl", dest = "foo" } ] - , dependencies = [ S.Dependency::{ module = "nix-base" } ] - } -``` -Running `seihou new-module` generates modules in this format automatically. -Available types: S.Module, S.Step, S.VarDecl, S.VarExport, S.Prompt, S.Command, S.Dependency, S.Migration, S.MigrationOp. - -### Empty list type annotations - -Dhall requires type annotations on empty lists. Common patterns: - exports = [] : List { var : Text, alias : Optional Text } - commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text } - dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } } - -### Variable types - -- text: String value -- bool: true/false/yes/no/1/0 -- int: Integer -- list: Comma-separated values -- choice: Must match one of the prompt's choices list +{{module_reference}} ## Prompt Schema Reference @@ -192,7 +77,7 @@ [ { src = "review-checklist.md", description = Some "Team review checklist" } ] , allowedTools = None (List Text) , tags = [ "review" ] -, launch = Some { provider = Some "codex-cli", mode = None Text, model = None Text } +, launch = Some { provider = Some "codex-cli", mode = None Text, model = None Text, effort = None Text } } ``` @@ -233,7 +118,7 @@ - **files**: reference files under `files/`. They are not copied or applied — they are context the launched agent can read. Validation fails if a declared file is missing; name them explicitly in the prompt body. -- **launch**: optional `provider` / `mode` / `model` hints for this prompt. +- **launch**: optional `provider` / `model` / `effort` preferences; `mode` is reserved and ignored. CLI flags and environment override these declarations; declarations override config. Trace is operator-controlled, not a launch field. - **tags**: discovery tags for registries, browse, install, and list filters. `seihou new-prompt NAME` generates a prompt in this format, including a sample @@ -316,7 +201,18 @@ - **template**: Replaces `\{{var}}` placeholders with values (most common) - **dhall-text**: Replaces placeholders, then evaluates as Dhall expression to Text - **structured**: Replaces placeholders, evaluates Dhall to record, serializes to JSON/YAML +- **symlink** with checkout lifecycle: declares an ignored project directory link (see Module Schema Reference) +### File ownership + +Choose lifecycle independently of rendering strategy. Use `lifecycle = Some "seed"` +for project-authored starters such as source stubs, Cabal files and changelogs; +keep policy/configuration that producers maintain managed. Seeds support only +whole-file copy/template/dhall-text without patches. Verify first run, pre-existing +files, forced reruns, deliberate deletion and ordinary update adoption. Do not add +migration/removal shell that rewrites or deletes seeds. Require Seihou 0.11.0.0+ +when publishing seed producers; older clients can ignore lifecycle. + ### Conditional expressions (when field) - `IsSet variable.name` — true if variable has a value - `Eq variable.name value` — true if variable equals value @@ -325,7 +221,6 @@ ### Composition patching (patch field) - `append-section` — wraps in section markers, appends -- `replace-section` — replaces content between existing section markers - `append-file` — appends to end without markers - `prepend-file` — prepends to beginning - `append-line-if-absent` — appends only lines not already present (idempotent, no markers) @@ -338,7 +233,7 @@ - `seihou new-module NAME` — scaffold a new module with boilerplate - `seihou new-blueprint NAME [--path DIR]` — scaffold a new blueprint (agent-driven) - `seihou new-prompt NAME [--path DIR]` — scaffold a reusable agent-session prompt -- `seihou validate-module [PATH]` — validate module.dhall (9 checks) +- `seihou validate-module [PATH]` — validate module.dhall - `seihou validate-blueprint [PATH]` — validate blueprint.dhall - `seihou validate-prompt [PATH]` — validate prompt.dhall - `seihou agent run BLUEPRINT [PROMPT]` — run a blueprint through the configured provider with the rendered prompt @@ -347,6 +242,9 @@ - `seihou run MODULE --dry-run [--var K=V]` — preview generation without writing - `seihou run MODULE [--var K=V]` — generate project - `seihou list` — list all available modules, recipes, blueprints, and prompts +- `seihou update [TARGET] [--dry-run]` — update recorded applications and preserve user edits +- `seihou sync [--dry-run]` — restore recorded links and execute declared repeatable checkout commands +- `seihou help` — discover conceptual help; use `seihou COMMAND --help` for flags - `seihou status` — show manifest state - `seihou diff` — compare manifest vs disk - `seihou config set|get|unset|list KEY [VALUE] [--global]` — manage config @@ -387,7 +285,7 @@ Understand what files should be generated, what variables the user needs, and what should be configurable vs hardcoded. -3. **Scaffold**: Run `seihou new-module NAME`, `seihou new-blueprint NAME`, +3. **Scaffold**: Run `seihou new-module NAME`, `seihou new-recipe NAME`, `seihou new-blueprint NAME`, or `seihou new-prompt NAME` to create the directory structure, then immediately customize the generated definition file. @@ -403,15 +301,12 @@ 6. **Add conditional steps**: Use `when` expressions for optional features (e.g., `when = Some "IsSet license"` for an optional LICENSE file). -7. **Plan for versioning**: Ask whether the user expects to ship breaking - layout changes later (file renames, removed files). If so, leave the - `migrations = [] : List Migration.Type` skeleton in place — when a - future v2 renames `app/` to `src/`, the author appends an - `S.Migration::{ from = "1.0.0", to = "2.0.0", ops = … }` entry so - consumers can run `seihou migrate ` instead of - reconciling by hand. Set an explicit initial `version` (e.g. - `Some "1.0.0"`) so the chain has a starting point. (Blueprints do not - support migrations — their output is non-deterministic.) +7. **Plan for versioning**: Set an explicit initial version. Modules can ship + deterministic layout migrations, automatically included by `seihou update`. + Blueprints can ship separate agent-guided library migrations with + `versionProbe`, ordered edges and optional `entails`; consumers use + `seihou agent migrate NAME`. Inspect with parent `--debug` before launching. + See `seihou help blueprints` and `seihou help migrations`. 8. **Validate**: Run `seihou validate-module ./MODULE`, `seihou validate-blueprint ./BLUEPRINT`, or diff --git a/data/module-reference.md b/data/module-reference.md new file mode 100644 --- /dev/null +++ b/data/module-reference.md @@ -0,0 +1,154 @@ +## Module Schema Reference + +Start with `seihou new-module NAME` and edit the generated `module.dhall`. +Preserve its pinned schema import and integrity hash; use record completion +(`S.Module::{ ... }`, `S.Step::{ ... }`) so optional fields get current defaults. +For an older module, preview `seihou schema-upgrade PATH --dry-run`, then apply +`seihou schema-upgrade PATH`. Do not invent a schema commit or hash. +Module names match `[a-z][a-z0-9-]*`. + +With `S` bound to the generated schema import, the module body can be: + +```dhall +S.Module::{ + name = "my-module", + version = Some "1.0.0", + description = Some "What this module does", + vars = [ S.VarDecl::{ name = "project.name", type = "text", required = True } ], + prompts = [ S.Prompt::{ var = "project.name", text = "Project name?" } ], + steps = [ S.Step::{ strategy = "template", src = "README.md.tpl", dest = "README.md" } ], + dependencies = [ S.Dependency::{ module = "nix-base" } ] +} +``` + +### Steps and lifecycles + +Ordinary file steps read `src` from the module's `files/` directory and write +`dest` in the consuming project. Strategies are `copy`, `template`, `dhall-text` +(Text output), and `structured` (Dhall record to JSON/YAML with composition). +The strategy field selects processing; filename extensions are conventions. +`when : Optional Text` gates a step. `patch : Optional Text` selects +`append-section`, `append-file`, `prepend-file`, or +`append-line-if-absent`. The default `lifecycle = None Text` means managed. + +For ignored directory links, use `strategy = "symlink"` with +`lifecycle = Some "checkout"` and no patch: + +```dhall +S.Step::{ strategy = "symlink", src = "agents/skills/my-skill", + dest = ".agents/skills/my-skill", lifecycle = Some "checkout" } +``` + +Here `src` is a real directory in the consuming project, not in the installed +module. Source and destination must be safe, non-overlapping project-relative +paths; `.git` and `.seihou` components are reserved. The destination must be +ignored and untracked. Declare an ignore rule as a managed step when needed. +Run/update records portable intent in the manifest; fresh clones and worktrees +restore links with `seihou sync`, without installed modules. Use typed links for +observable directory wiring rather than shell `ln` commands or command receipts. +For existing applications, a maintainer runs ordinary `seihou update ROOT` for the +recorded application, accepts the preview, and commits manifest, baselines, source +assets, ignore rules and any previewed tracked-link adoption. Teammates receive +that commit and run sync. Sync never fetches or updates specifications. + +### Commands and execution lifecycle + +The current schema uses a tagged action; new runtimes also accept pinned legacy +`{ run, workDir, when }` records as ordinary application commands. + +```dhall +commands = + [ S.Command::{ action = S.Command.Action.Apply "echo applied" } + , S.Command::{ action = S.Command.Action.Checkout "mkdir -p .local; echo ready > .local/setup" } + ] +``` + +Application commands use successful receipts during update; checkout commands are +explicitly repeatable local setup. Run and accepted actionable update execute both +in declaration/dependency order, while `--no-commands` suppresses both and retains +checkout declarations. A true no-op update executes neither. Sync executes only the +resolved checkout subset stored in manifest schema 10, without module/configuration +resolution or receipts. Repeated sync reruns all of it. Commit scripts needed by +these commands as project assets; never depend on a producer cache path. + +Checkout working directories must be real project-relative directories already +present in a receiving clone, with no symlink ancestors. Sync preflights all links +and working directories, creates links first, then executes commands sequentially. +A first failure stops the phase and reports the completed prefix and unrun tail; +retry with sync after correcting it. Arbitrary shell runs with user permissions, +may use the network and external tools, and cannot be undone by Seihou. Authors +must keep it repeatable and keep intended writes outside managed/tracked state. +Removal commands accept only application actions. Removing a checkout declaration +stops future execution and does not invent an inverse shell action. + +`lifecycle = Some "seed"` on a whole-file copy, template or dhall-text step +creates an absent file once and hands it to the project. No patches, structured +merges or symlinks are allowed. Existing regular files are kept. Manifest receipts +remember settlement and exact owning instances without hashes/baselines; edits +and deliberate deletion stay with the project through rerun, force, update, +status, diff and removal. Last-claim retirement forgets settlement, preserving disk. +An ordinary `seihou update TARGET` fetches producers/dependencies and previews +`release to project` for managed-to-seed transitions; no install or file-by-file +release prompts are needed. Reverse adoption requires explicit interactive +keep/accept consent, even with force. Declarative migrations/removal cannot mutate +seeds; arbitrary shell commands are unsandboxed and authors must keep them away. +Seed-producing modules require Seihou 0.11.0.0 or newer. Older binaries can +ignore lifecycle and overwrite content; users must update the runtime first. +For example: + +```dhall +S.Step::{ strategy = "template", src = "README.md.tpl", + dest = "README.md", lifecycle = Some "seed" } +``` + +### Variables and dependencies + +Declare `text`, `bool`, `int`, `list text`, or `choice` variables. Text lists use +comma-separated values. The decoder also recognizes `list bool` and `list int`, +but CLI coercion of those lists is not implemented. Choices come from a prompt's +`choices` list. Optional declarations include `default`, `description`, +`required`, and `validation`. Use `seihou vars NAME --explain` to inspect values. + +Initial resolution: CLI `--var`, `SEIHOU_VAR_*` environment, local config, +namespace config, context config, global config, parent dependency bindings, +then defaults; interactive prompts fill missing values. Ordinary updates reuse +saved application values immediately after CLI overrides. `--reconfigure` +intentionally resolves afresh. Agent provider settings use a separate chain; +inspect it with `seihou agent config` and `seihou help agent`. + +Parameterized dependencies use +`S.Dependency::{ module = "nix-flake", vars = [ { name = "nix.system", value = "aarch64-darwin" } ] }`. +Exports use `{ var : Text, alias : Optional Text }`. For a named composition +without new generation logic, use `seihou new-recipe NAME --module MODULE` +(repeat `--module`), then `seihou run NAME`; see `seihou help recipes`. + +### Removal + +```dhall +removal = Some S.Removal::{ steps = + [ S.RemovalStep::{ action = "remove-file", dest = "README.md" } + , S.RemovalStep::{ action = "remove-section", dest = ".gitignore" } + ] } +``` + +Removal steps use `action`, `dest`, and optional `src` (a Dhall rewrite function +under `files/` for `rewrite-file`). `S.Removal` also has `commands`. +Managed-file removal requires a removal declaration. Recorded checkout-only and +seed-only owners can be removed without one. Seed retirement keeps project files; +checkout retirement removes only the expected link and stops future setup, without +inventing inverse shell. Preview with +`seihou remove NAME --dry-run`; review conflicts before using `--force`. + +### Versioning and migrations + +Set an explicit module version. Declare layout changes with `S.Migration` and +`S.MigrationOp.MoveFile`, `MoveDir`, `DeleteFile`, `DeleteDir`, or `RunCommand`. +Edges run in ascending `from` order within the requested version window; gaps +are allowed, duplicate starts are invalid, and overlaps/overshoots are skipped. +Content-only changes normally need no migration: `seihou update TARGET` +reconciles generated content with user edits. It owns fetching, migrations, +inputs and cache publication in one preview/confirmation workflow. +Use `seihou migrate` for deliberate lower-level recovery or intermediate targets; +`seihou upgrade` only refreshes the installed cache. For blocked updates, inspect +`seihou agent upgrade TARGET --check` before requesting an agent repair. +See `seihou help update`, `seihou help migrations`, and `seihou help manifest`. diff --git a/data/prompt-run-prompt.md b/data/prompt-run-prompt.md --- a/data/prompt-run-prompt.md +++ b/data/prompt-run-prompt.md @@ -30,9 +30,9 @@ ## Reference Files The prompt includes the following reference files in its `files/` -subdirectory. They may be available to the user beside the prompt. When -you need information from a reference that is not shown in this prompt, ask -the user to provide it rather than claiming to have read it. +subdirectory. When tools can access the installed artifact, read the relevant +files directly. Otherwise ask the user for any reference content needed but +not shown here; do not claim to have read inaccessible files. {{reference_files}} diff --git a/data/setup-prompt.md b/data/setup-prompt.md --- a/data/setup-prompt.md +++ b/data/setup-prompt.md @@ -47,14 +47,15 @@ - Global defaults: `seihou config set KEY VALUE --global` - Namespace-specific: `seihou config set KEY VALUE --namespace NS` - Context-specific: First set context with `seihou context set NAME`, then - edit `~/.config/seihou/contexts/NAME/config.dhall` + use `seihou config set KEY VALUE --context NAME` - One-off overrides: pass `--var KEY=VALUE` to `seihou run` 5. **Preview**: Run `seihou run MODULE --dry-run [--var K=V]` to show what files will be generated. Review the plan with the user before proceeding. 6. **Execute**: Run `seihou run MODULE [--var K=V]` to generate files. Use `--force` - only if the user explicitly wants to overwrite conflicting files. + only if the user explicitly wants to overwrite conflicting managed files. + Seed steps preserve project edits and deliberate deletion even with force. 7. **Verify**: Check the results with `seihou status` and `seihou diff`. Read key generated files to confirm they look correct. @@ -62,23 +63,26 @@ 8. **Commit**: Stage and commit the generated files to git. See the Git Workflow section below for details. -9. **Stay current**: When a module's source repository ships a new version, the - user has two surfaces that surface migrations: - - `seihou outdated` lists installed modules whose source has advanced. - - `seihou upgrade` (or `seihou upgrade `) replaces the central - installed copy. If the new version declares `migrations` covering the - project's applied version, the upgrade output ends with an advisory: - `note: has N migration(s) pending; run 'seihou migrate '`. - - `seihou status` then shows a `Pending migrations: …` sub-line under that - module until the migrations are applied. - - `seihou migrate --dry-run` previews the plan; `seihou migrate - ` applies it (rewrites files, updates the manifest, bumps - `moduleVersion`). If the user wants both upgrade and migrate in one shot, - pass `--with-migrations` to `seihou upgrade`. - - When a migration's classifier reports `Conflict` for a file (the user has - edited it since generation), `seihou migrate` refuses without `--force`. - Confirm with the user before passing `--force`. +9. **Stay current**: Run `seihou update TARGET`. It fetches the recorded remote + and dependencies, reuses saved inputs, includes migrations, preserves user + edits, and previews before confirmation. No prerequisite `install`, `upgrade`, + or `migrate` sequence is needed for a recorded remote-backed application. + Use `--dry-run` for a separate preview and `--reconfigure` only to change + inputs deliberately. A `release to project` preview hands managed starters to + the project without rewriting bytes; normal confirmation covers the release. + Commit receipts so clones preserve edits/deletion. Reverse seed adoption needs + an explicit interactive keep/accept decision; force cannot consent. If blocked, `seihou agent upgrade TARGET --check` gives + a read-only diagnosis; `seihou agent upgrade TARGET` starts repair assistance. +10. **Fresh clones and worktrees**: At the Git root, run `seihou sync` to rebuild + declared ignored checkout links and execute recorded repeatable commands. + No installed producers are needed. With no declarations sync reports zero work. + A maintainer adopts changed specifications through `seihou update ROOT`, using + the recorded application target and saved inputs, then commits manifest, + baselines, ignore rules and source assets. Teammates receive the commit and sync. + Do not hand-edit manifest JSON or the Git index for routine adoption. Review + checkout shell instructions; they run with user permissions and must be repeatable. + Skip steps that don't apply. If the user already knows which module and variables they want, go directly to preview and execution. @@ -111,14 +115,14 @@ - `seihou run MODULE [--var K=V] [--dry-run] [--diff] [--force]` — run a module - `--dry-run`: preview the plan without writing files - `--diff`: show diff against current disk state - - `--force`: auto-resolve conflicts by overwriting + - `--force`: auto-resolve managed conflicts; settled seeds are preserved - `-m MODULE`: compose additional modules (repeatable) - `--namespace NS`: override namespace for config lookup - `-c CTX`: override context for config lookup - `--no-commands`: skip shell command steps - `seihou remove MODULE [--dry-run] [--force]` — remove an applied module by executing its declared removal steps - - Only works for modules with a `removal` section (not `None`) - - `--dry-run`: preview the removal plan (Delete, Strip, Rewrite, Run operations) + - Managed-file removal needs a `removal` section; recorded seed-only/checkout-only owners can be removed without a custom spec. Seed retirement keeps project files. Removal stops future setup and does not undo arbitrary shell effects. + - `--dry-run`: preview the removal plan (Delete, Strip, Rewrite, Run, and protected Keep operations) - `--force`: skip confirmation prompts - `seihou agent run BLUEPRINT [PROMPT] [--var K=V] [--no-baseline]` — run a blueprint - Discovers the blueprint, resolves variables (same precedence chain as `seihou run`), optionally applies base modules, then starts the configured provider @@ -128,23 +132,22 @@ - Discovers the prompt, resolves variables, runs command-derived variables, renders the prompt body, then starts the configured provider - `--debug`: print the rendered prompt without contacting the provider -### Upgrade and migration -- `seihou outdated` — show installed modules whose source repos have newer versions -- `seihou upgrade [MODULE] [--dry-run] [--with-migrations]` — replace the central installed copy of a module with the latest from its source - - Operates on `~/.config/seihou/installed/`, not on any project's working tree - - When the new version ships migrations covering an applied module, prints a one-line advisory: `note: has N migration(s) pending; run 'seihou migrate '` - - `--with-migrations`: after each upgrade, also run `seihou migrate` against the current project for any applied module that has pending migrations -- `seihou migrate MODULE [--dry-run] [--force] [--to VERSION] [--json]` — apply author-declared migrations to the current project - - Reads `migrations` from the installed module.dhall, plans a contiguous chain from the manifest's recorded version up to the installed version (or `--to`), classifies files (Safe / Conflict / Gone — mirrors `seihou remove`), and executes - - `--dry-run`: preview the plan (per-step op breakdown, total counts) - - `--force`: proceed even when files have user edits - - `--to VERSION`: stop at an intermediate version - - `--json`: machine-readable plan - - See `seihou help migrations` +### Updates, checkout restoration, and recovery +- `seihou update [TARGET] [--dry-run] [--var K=V]` — normal recorded-project update +- `seihou update TARGET --reconfigure` — intentionally resolve inputs afresh +- `seihou sync [--dry-run] [--json]` — restore recorded links and execute repeatable checkout commands; maintainer adoption uses ordinary update +- `seihou agent upgrade TARGET --check` — diagnose update readiness without repairs +- `seihou agent upgrade TARGET` — launch assistance when ordinary update is blocked +- `seihou manifest upgrade [--dry-run]` — explicitly convert older manifest schemas +- `seihou manifest repair-origins [--dry-run] [--set NAME=URL]` — repair machine-local recorded origins +- `seihou outdated` — inspect installed copies against their sources +- `seihou upgrade [MODULE] [--dry-run]` — deliberate installed-cache maintenance +- `seihou migrate MODULE [--dry-run] [--to VERSION]` — lower-level migration control +- See `seihou help update`, `seihou help sync`, and `seihou help manifest`. ### Status and diagnostics -- `seihou status` — show manifest state (applied modules, tracked files, variables); also surfaces a `Pending migrations: N migration(s) pending: X → Y` sub-line under any applied module whose installed copy has advanced past the manifest's recorded version with a covering chain -- `seihou diff` — compare tracked files against disk (modified, deleted, orphaned) +- `seihou status [--full-prompt]` — inspect recorded applications, artifact identity/version warnings, pending migrations and checkout links; pending updates name the recorded root target +- `seihou diff` — compare managed files against disk (modified, deleted, orphaned); seed receipts are counted without content comparisons - `seihou validate-module [PATH]` — validate a module definition - `seihou schema-upgrade [PATH] [--dry-run] [--all]` — upgrade module.dhall to current schema @@ -154,16 +157,11 @@ ## Variable Resolution -Variables resolve through a 9-level precedence chain (highest to lowest): - -1. CLI flags (`--var key=value`) -2. Environment variables (`SEIHOU_VAR_*`) -3. Local project config (`.seihou/config.dhall`) -4. Namespace config (`~/.config/seihou/namespaces//config.dhall`) -5. Context config (`~/.config/seihou/contexts//config.dhall`) -6. Global config (`~/.config/seihou/config.dhall`) -7. Parent-supplied vars (from parameterized dependencies) -8. Module defaults / interactive prompts +Initial variable resolution checks CLI flags, environment, local, namespace, +context and global config, parent dependency bindings, then defaults. Interactive +prompts fill missing values. Updates put saved application values immediately +after CLI overrides unless `--reconfigure` is requested. See the Module Schema +Reference below and `seihou help variables`. When helping users configure variables, choose the right scope: - **Project-specific** values (project.name, project.description) → local config @@ -172,59 +170,7 @@ - **Domain** defaults (haskell version, nix settings) → namespace config -## Module Schema Reference - -A Seihou module is a directory containing a `module.dhall` file and a `files/` subdirectory. - -### module.dhall format - -```dhall -{ name = "my-module" -, description = Some "What this module does" -, vars = - [ { name = "project.name" - , type = "text" -- text | bool | int | list | choice - , default = None Text -- or Some "value" - , description = Some "Description" - , required = True - , validation = None Text -- or Some "[a-z][a-z0-9-]*" (regex) - } - ] -, exports = [] : List { var : Text, alias : Optional Text } -, prompts = - [ { var = "project.name" - , text = "What is your project name?" - , when = None Text - , choices = None (List Text) - } - ] -, steps = - [ { strategy = "template" -- copy | template | dhall-text | structured - , src = "README.md.tpl" -- relative to files/ - , dest = "README.md" -- output path - , when = None Text - , patch = None Text - } - ] -, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text } -, dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } } -, migrations = [] : List Migration.Type -} -``` - -Modules may declare `migrations` — author-supplied steps that move a project's existing files between module versions. Consumers apply them with `seihou migrate `. Run `seihou help migrations` for detail. - -### Dependencies - -Dependencies use the record form `{ module, vars }`: - dependencies = [ { module = "nix-base", vars = [] : List { name : Text, value : Text } } ] - -### Variable types -- text: String value -- bool: true/false/yes/no/1/0 -- int: Integer -- list: Comma-separated values -- choice: Must match one of the prompt's choices list +{{module_reference}} ## Git Workflow @@ -237,13 +183,14 @@ to confirm they look right. 3. **Stage files**: Stage the generated files. The `.seihou/` directory should be - committed — it contains the manifest that tracks applied modules and enables - incremental updates. + reviewed: commit the portable manifest and project configuration. Commit real + source directories and ignore rules; leave ignored discovery links, trace + files, caches and temporary state untracked. Do not blindly stage `.seihou/`. -4. **Commit**: Write a clear commit message that mentions: +4. **Commit**: Use a Conventional Commit (for example `chore(seihou): apply my-stack`) that mentions: - Which module(s) were applied - Key variable values (e.g., project name) - - Example: "Apply haskell-base module for my-project" + - Example: "chore(seihou): apply haskell-base for my-project" 5. **Multiple modules**: If composing multiple modules, you can either commit after each module or after all modules are applied. Committing after each gives a @@ -255,7 +202,8 @@ ## Response Guidelines -- Provide exact commands for `seihou`, `git`, and related checks instead of claiming to run them. +- When tools are available, run the authorized workflow and report actual results. + Otherwise provide exact local commands and do not claim they were executed. - Recommend previewing with `--dry-run` before running for real unless the user explicitly wants to skip. - Recommend `seihou status` after generation to confirm what was applied. - Use `seihou vars MODULE --explain` in suggested workflows when the user needs to understand variable resolution. diff --git a/data/upgrade-prompt.md b/data/upgrade-prompt.md --- a/data/upgrade-prompt.md +++ b/data/upgrade-prompt.md @@ -71,10 +71,11 @@ Work through these steps in order. Repair a failing check with the playbook below before moving on, and diagnose again after each repair. -1. If the git working tree has uncommitted changes, ask the user before touching - anything, and suggest committing or stashing them first. -2. Run `seihou outdated` to find the newest release of `{{module}}`. -3. Run `seihou upgrade {{module}}` to refresh the installed copy. +1. Review `git status` and preserve unrelated user changes. Resolve only changes + that block this upgrade with the user; do not require a blanket stash. +2. Use the diagnosis below and `seihou help update` to identify required repairs. +3. Do not pre-install dependencies or refresh the cache: ordinary update owns + fetching the recorded source/dependencies and publishing the cache on success. 4. Run `seihou update {{module}} --dry-run` and walk the user through the plan: version changes, migrations, files, commands, and warnings. 5. Run `seihou update {{module}}`. Resolve any conflicts with the user. @@ -111,7 +112,9 @@ ### no_recorded_applications and legacy_update_requires_one_target The manifest predates recorded applications. Run one `seihou update {{module}}` -(exactly one target) to seed the record. Later updates can name any target. +(exactly one target) to seed the record. This also works for an older recorded +root alongside newer applications: update fetches its saved remote and includes +matching recorded dependencies in the normal preview. Later updates can name any target. ### target_not_found `{{module}}` is not a recorded target. The message lists the ones that are. Ask @@ -181,11 +184,38 @@ does, and decide together whether to fix the project first or to upgrade to an intermediate version. +### Checkout setup refusal or missing declarations +Run `seihou sync` to restore recorded links and repeatable checkout commands. +An empty declaration set is zero work. A maintainer adopts changed producer specs +with ordinary `seihou update ROOT`, using the recorded application target. That +preview owns source/dependency resolution, saved inputs and safe tracked-link +adoption. Preserve modified/staged links and regular files. Do not manually alter +the Git index or manifest JSON. Commit accepted manifest, baselines, assets and +ignore rules, then teammates receive that commit and sync without producer lookup. +Checkout shell may use tools/network and cannot be rolled back; correct failure +and retry sync. For an interrupted update, `seihou update --dry-run` recovers the +prior transaction before previewing new work; then retry sync. + ### composition_failed and reconciliation_failed The new release does not compose with the rest of the project, or its files cannot be reconciled with what is recorded. Show the user the message; this is usually a module bug to report, not a project repair. +### seed_release_blocked_by_owners + +A managed-to-seed release still has managed owners outside the selection, even if +those owners previously wrote additive patches. Review `seihou update --dry-run` +to include all recorded applications together. Every candidate owner must agree +on seed lifecycle; mixed managed/seed/checkout declarations require a compatible +producer release, not manual ledger edits. + +### seed_adoption_requires_interaction + +A producer proposes managing a project-owned seed. Run ordinary interactive +`seihou update {{module}}` so the user can keep current content and manage it, +accept generated content, or abort. A deleted seed offers recreate-and-manage or +abort. Equal bytes still require consent. Neither force nor JSON can grant it. + ### unresolved_paths Some files have conflicts that need a decision. Run an interactive `seihou update {{module}}` with the user and resolve each one. @@ -212,7 +242,11 @@ what the user confirms. - Never mark a path `additive-only` without reading every owner's operations for that path in the modules themselves. -- Never delete file records or applications to get past a gate. +- Never delete file records, seed receipts or applications to get past a gate. +- Treat `release to project` as a metadata handoff: preserve seed bytes and absence. + Do not auto-stage existing project edits because their paths were released. +- During seed-creation recovery, preserve later edits/replacements and follow the + recovery message; never delete a project object to make the journal look clean. - Never lower a recorded version. - Never pass `--force` or `--allow-downgrade` without the user's agreement. - Never change anything under `~/.config/seihou/installed/` except through diff --git a/help/agent.md b/help/agent.md --- a/help/agent.md +++ b/help/agent.md @@ -12,13 +12,15 @@ USAGE - seihou agent [--debug] [--provider PROVIDER] [--model MODEL] [options] + seihou agent [--debug] [--provider PROVIDER] [--model MODEL] [--effort LEVEL] [--trace SETTING] [options] PARENT OPTIONS --debug Print the resolved system prompt and exit without contacting any - provider. Use this to inspect what Seihou would send. + provider. Use this to inspect what Seihou would send. Artifact + debug renders still run declared commandVars/version probes; + agent upgrade also saves its brief outside the project. --provider PROVIDER Select the provider for this invocation. Accepted values: @@ -28,7 +30,17 @@ Select a provider-specific model name or alias for this invocation. Run `seihou agent models` to list known choices. -Provider and model options may appear on the parent command or on the + --effort LEVEL + Reasoning effort: minimal, low, medium, high, xhigh, or max. + Omitted effort leaves the provider's choice in effect. + + --trace SETTING + Record model calls: off (default), file, stdout, or stderr. + File output uses agent.tracePath (local, then global), default + .seihou/trace.jsonl. Traces cover batch/API calls; interactive + CLI sessions emit no call events. --debug contacts no provider. + +Provider, model, effort and trace options may appear on the parent command or on the subcommand: seihou agent --provider codex-cli --model gpt-5 assist "create a module" @@ -40,12 +52,12 @@ claude-cli Starts an interactive Claude Code session. Requires the `claude` binary on PATH and a working local login. With no - explicit model, the CLI chooses its own default. + explicit model, Seihou passes its pinned default, `claude-opus-4-8`. codex-cli Starts an interactive Codex session. Requires the `codex` binary on PATH and a working local login. With no explicit - model, the CLI chooses its own default. Seihou launches Codex + model, Seihou passes its pinned default, `gpt-5.6-terra`. Seihou launches Codex with workspace-write sandboxing and on-request approvals. anthropic @@ -60,27 +72,43 @@ CONFIGURATION -Provider and model values resolve independently from module variables. -The first non-blank value wins: +Provider, model, effort and trace resolve independently of module variables. +The first non-blank value wins for each field: - 1. Subcommand CLI flags: `--provider`, `--model` - 2. Parent CLI flags: `--provider`, `--model` - 3. Environment: `SEIHOU_AGENT_PROVIDER`, `SEIHOU_AGENT_MODEL` - 4. Local config: `.seihou/config.dhall` - 5. Global config: `~/.config/seihou/config.dhall` - 6. Built-in defaults: provider `claude-cli`, no explicit model + 1. Subcommand CLI flag + 2. Parent agent CLI flag + 3. SEIHOU_AGENT_PROVIDER / MODEL / EFFORT / TRACE environment variables + (each name has the SEIHOU_AGENT_ prefix) + 4. blueprint.dhall or prompt.dhall launch.{provider,model,effort} + 5. Local agent..{provider,model,effort,trace} + 6. Local agent.{provider,model,effort,trace} + 7. Global agent..{provider,model,effort,trace} + 8. Global agent.{provider,model,effort,trace} + 9. Built-in defaults (provider claude-cli; pinned CLI models above; + API models as above; effort unset; trace off) -Set personal defaults globally: +Local config is .seihou/config.dhall; global is ~/.config/seihou/config.dhall. +Artifact launch declarations apply only to agent run, agent migrate and +prompt run. launch.mode is reserved and ignored; launch has no trace field. +Use `--verbose` on artifact runs to see resolved settings and sources. +Command key segments are assist, bootstrap, setup, upgrade, run, migrate, +and prompt-run (for `seihou prompt run`). + seihou agent config seihou config set agent.provider codex-cli --global - seihou config set agent.model gpt-5 --global - -Use environment variables for a temporary shell session: + seihou config set agent.bootstrap.effort high --global + seihou config set agent.prompt-run.trace file + seihou config set agent.tracePath .seihou/trace.jsonl - export SEIHOU_AGENT_PROVIDER=openai - export SEIHOU_AGENT_MODEL=gpt-4o-mini +`seihou agent config` is read-only and shows each command's provider, model, +effort, trace and source. Its table cannot include a specific artifact's +launch declaration; use the run's --verbose output for that. SUBCOMMANDS + + seihou agent config + Inspect resolved per-command settings and their sources without + starting a provider or changing configuration. seihou agent models [--provider PROVIDER] List the Anthropic and OpenAI models in Seihou's compiled Baikai diff --git a/help/blueprints.md b/help/blueprints.md --- a/help/blueprints.md +++ b/help/blueprints.md @@ -40,11 +40,13 @@ 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). + migrations Agent-guided library edges (from, to, prompt, optional entails). + versionProbe Optional read-only command to infer the target library version. + launch Optional provider/model/effort preferences; mode is reserved. Blueprints share the same name lookup namespace as modules and recipes. If a directory contains more than one runnable definition, lookup prefers - `module.dhall`, then `recipe.dhall`, then `blueprint.dhall`. + `module.dhall`, then `recipe.dhall`, then `blueprint.dhall`, then `prompt.dhall`. VARIABLES AND PROMPTS @@ -76,6 +78,11 @@ agent runner records the applied blueprint in `.seihou/manifest.json` after a successful run, including baseline provenance. + Baseline seed steps create project-owned starters once and preserve edits or + deliberate deletion on rerun, including force. Agents extend those files as + authorized project work. Status/diff do not compare their contents. Commit seed + receipts for clones; ordinary update owns lifecycle transitions (see modules). + REFERENCE FILES Files declared in the `files` list must live under the blueprint's `files/` @@ -111,12 +118,12 @@ migrations = [ S.BlueprintMigration::{ - , from = "1.0.0" + from = "1.0.0" , to = "2.0.0" , prompt = ./migrations/1-to-2.md as Text } , S.BlueprintMigration::{ - , from = "2.5.0" + from = "2.5.0" , to = "3.0.0" , prompt = ./migrations/2-5-to-3.md as Text } @@ -125,6 +132,12 @@ Run an installed library blueprint with explicit versions: seihou agent migrate my-library --from 1.0.0 --to 3.0.0 + + --to can be inferred by versionProbe; --from can be inferred from receipts. + With no previous receipts, pass --from explicitly. An edge may declare + `entails` to schedule another blueprint's edges in the same plan. Receipts + belong to the blueprint owning each edge. A not-applicable result records + the reason without suppressing a future run when its precondition is met. Edges run in ascending `from` order and gaps are allowed. Duplicate starts are invalid; overlaps already passed by the cursor and edges overshooting the diff --git a/help/config.md b/help/config.md --- a/help/config.md +++ b/help/config.md @@ -42,8 +42,9 @@ HOW CONFIG FEEDS INTO MODULES When you run a module, Seihou resolves each declared variable by - checking (in order): CLI overrides, config scopes, exported values - from dependencies, and finally defaults or prompts. Use 'seihou vars + checking (in order): CLI overrides, saved application values on ordinary + update, SEIHOU_VAR_* environment, the config scopes above, parent + dependency bindings, and defaults. Prompts fill missing values. Use 'seihou vars MODULE --explain' to see where each value comes from. TYPICAL SETUP diff --git a/help/contexts.md b/help/contexts.md --- a/help/contexts.md +++ b/help/contexts.md @@ -29,9 +29,11 @@ Seihou determines the active context by checking: - 1. Project context .seihou/context file in the current directory - 2. Global default ~/.config/seihou/default-context - 3. None No context is active + 1. CLI context --context / -c on commands that support it + 2. Environment SEIHOU_CONTEXT + 3. Project context .seihou/context file in the current directory + 4. Global default ~/.config/seihou/default-context + 5. None No context is active The project context takes priority, so you can have a global default of "personal" but override it to "work" in specific project directories. diff --git a/help/extensions.md b/help/extensions.md new file mode 100644 --- /dev/null +++ b/help/extensions.md @@ -0,0 +1,22 @@ +EXTENSIONS + + seihou extension run NAME -- ARGS... + +Seihou locates seihou-NAME-extension on PATH and forwards everything after -- +unchanged. The extension owns its options, output and help. If it is absent, +install its executable or put it on PATH. A failing extension's exit status is +returned by Seihou. + +OKF DOCUMENTATION + + seihou extension run okf -- --help + seihou extension run okf -- docs --dir . --out okf-docs + + The separately installed seihou-okf-extension generates an Open Knowledge + Format bundle from a Seihou registry. Its --force option replaces a non-empty + output directory; inspect its own help before choosing options. + +SEE ALSO + + seihou extension --help + seihou help registry diff --git a/help/git-repository.md b/help/git-repository.md --- a/help/git-repository.md +++ b/help/git-repository.md @@ -11,7 +11,7 @@ my-module/ module.dhall - templates/ + files/ ... Install with: diff --git a/help/manifest.md b/help/manifest.md --- a/help/manifest.md +++ b/help/manifest.md @@ -59,7 +59,12 @@ shared-write evidence .gitignore unknown -> additive-only - ✓ Upgraded .seihou/manifest.json to schema version 7. + 7 -> 8 seed receipts + 8 -> 9 checkout outputs + 9 -> 10 repeatable checkout commands + 10 -> 11 precise seed ownership claims + + ✓ Upgraded .seihou/manifest.json to schema version 11. Review the diff and commit it: git diff .seihou/manifest.json Running it on a manifest that is already current reports that there is @@ -75,7 +80,8 @@ After reaching schema 7 the upgrade compiles each unknown file's owners from their recorded module versions and saved values, writes nothing but the manifest, and records what it finds. An owner whose recorded version is not - installed here leaves the file unknown, and the report names it. + installed here is fetched at its recorded release from its remote origin. + If that also fails, the file stays unknown and the report gives the reason. seihou update performs the same certification for just the shared paths it touches and records it with the update, so running this first is @@ -119,6 +125,18 @@ The write is atomic: a complete temporary file is renamed over the manifest, so an interrupted run cannot leave a truncated one. + +SCHEMA 8 THROUGH 11 + + Schema 8 adds content-free seed receipts; schema 11 records exact application/ + qualified-instance claims and explicitly preserves legacy ownership uncertainty. + Schema 9 adds portable checkout directory-link declarations and ownership. + A lossless schema upgrade adds empty collections; it cannot infer declarations + from old shell command receipts. Schema 10 adds a required checkoutCommands list + to each application; the adjacent upgrade adds empty lists, never inferred setup. + A maintainer adopts changed declarations through ordinary update and commits + them. Teammates receive that commit and run seihou sync, without producers. + Sync does not fetch, upgrade or write the manifest. See seihou help sync. SEE ALSO diff --git a/help/migrations.md b/help/migrations.md --- a/help/migrations.md +++ b/help/migrations.md @@ -7,10 +7,16 @@ BLUEPRINT MIGRATIONS A library blueprint declares entries with `from`, `to`, and a Markdown - `prompt`. Consumers always supply explicit dotted numeric versions: + `prompt`. Consumers can supply explicit dotted numeric versions: seihou agent migrate my-library --from 1.0.0 --to 3.0.0 + Omit --to to use the blueprint's read-only versionProbe; omit --from to use + the highest recorded receipt version. With no starting receipt, supply --from. + Edges may entail edges owned by other blueprints. A not-applicable session + records a reason and continues, but does not mark that edge applied; it can + run again later. See `seihou help blueprints` and `seihou help agent`. + 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. @@ -132,6 +138,15 @@ "leapfrog" migration alongside the smaller steps should declare the longer span and let the smaller overlapping edges sit unused — the cursor will advance past them after picking the leapfrog. + +PROJECT-OWNED SEEDS + + Declarative move/delete operations cannot touch settled seeds or paths being + released to seed ownership, including ancestor directories and destinations. + Force does not bypass this. Managed-to-seed handoff needs no migration script; + ordinary update previews "release to project" and preserves bytes or absence. + Fix incompatible producer migrations rather than editing the manifest. + Arbitrary shell commands remain unsandboxed and must not mutate seeds. CONFLICT SEMANTICS diff --git a/help/modules.md b/help/modules.md --- a/help/modules.md +++ b/help/modules.md @@ -30,13 +30,16 @@ GENERATION STRATEGIES - Each step in a module uses one of four strategies: + Ordinary file steps use one of four content strategies: Copy Copy a file verbatim from the module to the output. - Template Render a Mustache-style template with resolved variables. + Template Render placeholders and {{#if}} blocks with resolved variables. DhallText Evaluate a Dhall expression that produces Text output. - Structured (Reserved for future structured merge support.) + Structured Evaluate a Dhall record and serialize JSON/YAML; supports composition. + The strategy field selects processing; source extensions are conventions. + A fifth strategy, symlink, is for checkout directory links (see below). + DEPENDENCIES Modules can declare dependencies on other modules using the record form: @@ -66,6 +69,7 @@ sha256: in S.Module::{ name = "my-module" + , version = Some "1.0.0" , steps = [ S.Step::{ strategy = "template" , src = "foo.tpl", dest = "foo" } ] } @@ -78,7 +82,7 @@ seihou list List all available modules seihou new-module my-template Scaffold a new module seihou validate-module ./my-module Check a module is well-formed - seihou install Install modules, recipes, or blueprints from git + seihou install Install modules, recipes, blueprints, or prompts from git seihou run --var k=v Run a module to generate files seihou update [target] Update a recorded application and preserve user edits seihou remove Remove an applied module and its files @@ -95,6 +99,31 @@ operation. Run `seihou help update` for the project workflow or `seihou help migrations` for the authoring reference. -## Checkout directory links +STEP LIFECYCLES -A step with strategy `symlink` and lifecycle `Some "checkout"` declares a link from a real project source directory to an ignored local path. Run records portable intent; `seihou sync` reconstructs it in fresh clones without modules or commands. For example, link `config/editor` to `.editor-local/config` and ignore `.editor-local/`. Links have no patches or content hashes. + Omitted lifecycle means managed. Some "seed" is accepted for whole-file + copy/template/dhall-text steps without patches. Run creates absent seeds + once and keeps existing regular files. Receipts preserve edits and deliberate + deletion through reruns, force, update and removal. Status/diff count receipts + without comparing seed contents. Update TARGET previews "release to project" + for managed-to-seed adoption; reverse adoption requires explicit consent. + Shell commands are unsandboxed: authors must not mutate seed-owned files. + Seed producers require Seihou 0.11.0.0 or newer. Update the runtime first; + older clients can ignore lifecycle and overwrite content. + +CHECKOUT DIRECTORY LINKS + +A step with strategy `symlink` and lifecycle `Some "checkout"` declares a link from a real project source directory to an ignored local path. Run records portable intent; `seihou sync` reconstructs it in fresh clones without producer resolution or application command replay. For example, link `config/editor` to `.editor-local/config` and ignore `.editor-local/`. Links have no patches or content hashes. + +Run `seihou help sync` for fresh clones, worktrees and existing tracked-link adoption. +Run `seihou help recipes` for named compositions of modules. + + +Commands use `S.Command::{ action = S.Command.Action.Apply "echo applied" }` +or `S.Command::{ action = S.Command.Action.Checkout "mkdir -p .local/setup" }`. +The latter is explicitly repeatable local setup, resolved and recorded during run +or update for teammates to execute with sync. It runs with user permissions and +may need tools/network. Keep intended writes outside tracked/managed state and +working directories real and project-relative. Ordinary receipts never suppress +checkout commands. `--no-commands` suppresses both lifecycles while retaining setup; +a true no-op update executes neither. Removal accepts application commands only. diff --git a/help/prompts.md b/help/prompts.md --- a/help/prompts.md +++ b/help/prompts.md @@ -17,8 +17,8 @@ review-changes/ prompt.dhall Prompt definition (required) - prompt.md Markdown body imported by prompt.dhall - files/ Optional reference files for the agent + prompt.md Markdown body imported by prompt.dhall + files/ Optional reference files for the agent `seihou new-prompt review-changes` creates this layout. @@ -35,7 +35,7 @@ files Reference files under the prompt's files/ directory. allowedTools Optional tool allow-list metadata. tags Optional discovery tags. - launch Optional provider/mode/model hints. + launch Optional provider/model/effort preferences; mode is reserved and ignored. Prompts share the same name lookup namespace as modules, recipes, and blueprints. If a directory contains multiple runnable definitions, lookup @@ -109,6 +109,17 @@ The selector flag is still named `--module` for compatibility, but it can select any registry entry kind. + +LAUNCH AND DEBUG + + launch.{provider,model,effort} overrides config but loses to CLI flags and + SEIHOU_AGENT_* environment variables, independently per field. Trace is an + operator setting, not an artifact launch field. Run `seihou agent config` + for configured defaults and add --verbose to a prompt run for its resolved + settings/sources. See `seihou help agent`. + + --debug skips the provider, but still runs commandVars to render the prompt. + Review their commands before inspecting an unfamiliar prompt. FURTHER READING diff --git a/help/recipes.md b/help/recipes.md new file mode 100644 --- /dev/null +++ b/help/recipes.md @@ -0,0 +1,48 @@ +RECIPES + +A recipe is a named deterministic composition of modules, with optional typed +variables, interactive prompts and per-module bindings. Use it when existing +modules already provide the generation logic and one command should apply them. + +AUTHOR AND RUN + + seihou new-recipe my-stack --module base --module editor + + This creates my-stack/recipe.dhall with the selected modules. Edit the + generated definition to add variables or bindings. Preserve its field shapes. Put it in a normal search path (for example + .seihou/modules/my-stack/) or publish/install it through a registry. + + seihou vars my-stack + seihou run my-stack --dry-run + seihou run my-stack + + Dependencies resolve before generation. Supply declared values with --var + or normal config scopes. There is no validate-recipe command; inspect vars + and the run preview, and use registry validate for published entry metadata. + +UPDATES + + seihou update my-stack + + Update the recorded root application to fetch sources, reuse accepted + inputs, apply migrations and preserve project edits. You do not need to + enumerate transitive modules. Use status to inspect the recorded application. + Checkout links declared by its modules are restored in fresh clones with sync. + Seed steps from every contributing instance retain exact claims while the first + supplier provides initial bytes. Reruns/updates preserve edits and deletion; + removing the last claim retires settlement without deleting the project file. + +CHOOSING AN ARTIFACT + + Module Deterministic generation steps and template files + Recipe Named composition of existing modules + Blueprint Agent-driven project work, optionally with baseline modules + Prompt Reusable agent-session task without blueprint provenance + +SEE ALSO + + seihou help modules + seihou help variables + seihou help update + seihou help registry + seihou new-recipe --help diff --git a/help/registry.md b/help/registry.md new file mode 100644 --- /dev/null +++ b/help/registry.md @@ -0,0 +1,39 @@ +REGISTRY + +A multi-artifact repository declares seihou-registry.dhall at its root. Lists +named modules, recipes, blueprints and prompts contain entries with name, +optional version/description, project-relative path and tags. Each path points +to the directory holding the corresponding runnable definition. Names must be +unique across kinds; paths must be relative without parent traversal. + +AUTHOR WORKFLOW + + seihou registry sync-versions --dry-run + seihou registry sync-versions + seihou registry validate + + Sync-versions reads each item's declared version and refreshes registry + metadata. It rewrites the whole Dhall file, so review formatting/comments in + the diff. --check instead exits nonzero on missing, stale or orphaned entries + without writing; use it in CI. Validate checks structure and version agreement. + Both commands accept --dir PATH, work locally and do not read installed copies. + + Validate item contents with validate-module, validate-blueprint or + validate-prompt as appropriate; registry validation checks metadata. + +CONSUMERS + + seihou browse GIT-URL + seihou install GIT-URL --module NAME + seihou install GIT-URL --all + + --module can select any entry kind. Applied modules/recipes are advanced with + update; upgrade refreshes only the installed cache. See git-repository. + +SEE ALSO + + seihou registry --help + seihou help git-repository + seihou help recipes + seihou help blueprints + seihou help prompts diff --git a/help/sync.md b/help/sync.md new file mode 100644 --- /dev/null +++ b/help/sync.md @@ -0,0 +1,66 @@ +# seihou sync + +Reproduce the module-declared local setup recorded in this checkout's manifest. + +```sh +seihou sync [--dry-run] [--json] +``` + +Run at the Git working-tree root after cloning or receiving project changes. +No installed producer modules or personal configuration are needed. Sync reads the +accepted manifest, restores its ignored directory links, then executes its ordered +repeatable checkout commands. It never fetches producers, upgrades modules, +regenerates managed files, runs migrations, or rewrites the manifest, baselines or +Git index. A producer's shell command may itself use external tools or the network +and runs with your environment and permissions. Review the project's declarations +before explicitly running sync; Seihou installs no automatic hook. + +`--dry-run` shows the recorded links and commands without executing commands or +changing anything. `--json` emits one structured document, capturing command output +inside command results. Default output names created, repaired and unchanged links, +and succeeded, failed and not-run commands with application and instance identity. +A refusal or command failure exits nonzero. + +A module records checkout commands with `S.Command.Action.Checkout`, and ordinary +application commands with `S.Command.Action.Apply`. Sync runs only the checkout +subset, in recorded dependency/declaration order. Independent applications run in +application-ID order. Repeated sync runs every recorded checkout command again; +success receipts never suppress them. Authors must make these commands repeatable +and keep intended writes outside managed/tracked project state. Seihou cannot +sandbox or undo arbitrary shell effects. + +All links and command working directories are checked before changes. Sources and +working directories must already be real project directories with real ancestors. +A regular object collision refuses the whole setup without overwriting it. Link +sources cannot be supplied by a later checkout command. A command's working +directory is checked again immediately before invocation. The first command failure +stops execution; the report retains the completed prefix, captured output, exit code +when available, and unrun tail. Local effects remain. Correct the failure and run +`seihou sync` again to repeat the complete local command phase. + +An interrupted update blocks sync, including dry-run. Run `seihou update --dry-run`: +its entry path recovers the interrupted transaction's files and index before +previewing a new update. Then retry sync. + +## First-time adoption + +An empty declaration set is successful zero work: it means no checkout setup has +been recorded. Sync does not infer setup from command receipts or discover a newer +producer. A maintainer adopts a changed specification through the recorded root: + +```sh +seihou update master-plan +``` + +Review and accept the ordinary preview, then commit generated assets, ignore rules, +baselines and manifest. Update resolves the recorded source and dependencies, reuses +saved inputs, prepares supported older schemas and previews eligible tracked-link +adoption. Teammates receive that commit and run `seihou sync`. `--no-commands` on +run/update suppresses execution while retaining setup declarations for teammates. +An unchanged update executes no commands; use sync to repeat local setup. + +Schema 10 records checkout commands; schema 9 links and older supported manifests +remain readable without a schema write during sync. Old runtimes reject schema 10. +Ordinary historical command receipts remain application history and are never +converted into repeatable setup instructions. Updating declarations replaces their +recorded setup; removal stops future execution without inventing inverse commands. diff --git a/help/templating.md b/help/templating.md --- a/help/templating.md +++ b/help/templating.md @@ -1,8 +1,7 @@ TEMPLATING -The Template strategy is the middle rung of Seihou's four generation -strategies. It is dispatched by the .tpl file extension and gives a step -two powers: replace {{variable.name}} with the resolved value, and gate +A step with strategy = "template" processes its source regardless of file +extension (.tpl is a naming convention). It gives a step two powers: replace {{variable.name}} with the resolved value, and gate regions of text on a boolean expression via {{#if ...}} blocks. Templates stay intentionally dumb. Anything richer -- loops, arithmetic, @@ -34,7 +33,8 @@ Template bodies the .tpl file contents Destination path the `dest` field of a step - Shell commands the `run` and `workDir` fields of command steps + Shell commands the action shell text and `workDir` fields of commands + (legacy records use `run`) ESCAPING {{ @@ -65,7 +65,7 @@ referenced inside the gate. Conditional blocks work in template bodies only. They do NOT work in - `dest`, `run`, or `workDir`; those positions accept placeholders only + `dest`, action shell text, legacy `run`, or `workDir`; those positions accept placeholders only and will treat {{#if}} as a placeholder name that fails to resolve. The dhall-text and structured strategies express conditionals with Dhall's own if/then/else after placeholder substitution. diff --git a/help/update.md b/help/update.md --- a/help/update.md +++ b/help/update.md @@ -34,7 +34,8 @@ 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. + new generated content, reconciles files, and runs new or changed application commands plus selected repeatable checkout + commands on an actionable update. The installed cache and manifest are published only after the managed update succeeds. @@ -60,12 +61,16 @@ `requires-ownership-closure`, or `unknown` for a manifest that predates it. A targeted update resolves `unknown` itself: it compiles each co-owner from its recorded version, reads how it writes the path, and records the answer - (upgrading a schema-6 manifest to 7) with its own manifest. It inspects the - co-owners but never updates their files. `--dry-run` shows this as - `Manifest: schema 6 -> 7` and writes nothing. + with the required lossless manifest preparation. It inspects the co-owners + but never updates their files. `--dry-run` shows any required schema + transition and writes nothing. - If a co-owner's recorded version is not installed here, the update stops - with `shared_write_evidence_unavailable`: install that version and retry. + If a co-owner's recorded version is not installed here, update fetches its + exact recorded release from its origin for certification. It does not update + that co-owner. Only if evidence still cannot be obtained does it stop with + `shared_write_evidence_unavailable`; fix the reported origin/network problem + or deliberately include the co-owner. Machine-local origins can be repaired + with `seihou manifest repair-origins --dry-run`, then the apply command. A schema-5 or older manifest stops with `manifest_upgrade_required`: run `seihou manifest upgrade --dry-run`, review, then `seihou manifest upgrade`. @@ -115,10 +120,14 @@ 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. + By default, only new or changed application commands run; checkout commands + repeat during an accepted actionable update, in their original mixed order. + Their presence alone does not make update actionable. A declaration change does. + A true no-op executes neither lifecycle; use sync to repeat recorded local setup. + --run-all-commands explicitly makes command execution actionable; --no-commands + suppresses both lifecycles while retaining checkout declarations. Those flags + are mutually exclusive. Only application commands receive success receipts, + published after the entire phase succeeds. PREVIEW, AUTOMATION, AND COMMITS @@ -155,3 +164,18 @@ seihou help migrations seihou status --help docs/cli/update.md + +For recorded local setup, use `seihou sync`: it repairs links and executes declared +repeatable commands without producer resolution. Maintainers adopt changed specs +through ordinary update and commit them before teammates sync. A true no-op update +executes neither command lifecycle; --no-commands preserves setup declarations. + +PROJECT-OWNED SEEDS + + Update TARGET previews "release to project" when a producer hands managed + starter files to the project. Normal confirmation preserves bytes or absence + and removes managed hashes/baselines. New absent seeds are created once; + receipts preserve later edits and deletion. Commit the manifest for clones. + Last-claim retirement keeps disk contents. Reverse seed-to-managed adoption + requires an explicit interactive keep/accept choice; --force/JSON cannot consent. + Declarative migrations cannot touch seeds. Arbitrary shell is unsandboxed. diff --git a/help/variables.md b/help/variables.md --- a/help/variables.md +++ b/help/variables.md @@ -6,28 +6,30 @@ DECLARING VARIABLES - Each variable in module.dhall has: - - name Dotted name like "project.name" or "author.email" - type Text (the only type currently supported) - default Optional default value - description Human-readable explanation (shown in prompts) - - Variables without defaults are required — Seihou will prompt for them - interactively or fail if no value is available. + Each declaration has name, type, optional default/description/validation, + and a required flag. Supported CLI types are text, bool, int, list text, + and choice. Text lists are comma-separated; choices use a prompt's choices. + list bool/list int decode as types but their CLI coercion is not implemented. + Required variables with no resolved value prompt interactively or fail when + no prompt can supply a value. Optional variables may remain unset. RESOLUTION ORDER - When resolving a variable's value, Seihou checks these sources in order: + Highest precedence first: 1. CLI overrides --var project.name=my-app - 2. Config values From config.dhall (local, namespace, or global) - 3. Context values From the active context's config.dhall - 4. Exported values From dependency modules that export the variable - 5. Default value Declared in module.dhall - 6. Interactive prompt If running in a TTY, prompt the user + 2. Saved inputs Ordinary update only (unless --reconfigure) + 3. Environment SEIHOU_VAR_PROJECT_NAME + 4. Local config .seihou/config.dhall + 5. Namespace config ~/.config/seihou/namespaces//config.dhall + 6. Context config ~/.config/seihou/contexts//config.dhall + 7. Global config ~/.config/seihou/config.dhall + 8. Parent bindings Parameterized dependencies + 9. Default value Declared in the artifact - The first source that provides a value wins. + Interactive prompts fill missing values after this resolution. Initial + generation has no saved-input tier. Agent provider/model/effort/trace + settings use a different precedence chain; see `seihou help agent`. EXPORTS @@ -46,7 +48,6 @@ NAMESPACING - When composing multiple modules, variables are scoped by module namespace - to avoid collisions. The namespace defaults to the module name but can be - overridden with --namespace. Config keys under a namespace are looked up - as namespace.variable.name. + The namespace selects a separate config file, not a prefix added to every + variable name. Use --namespace NS to override the artifact's default + namespace. `seihou vars NAME --explain` reports the resolved source. diff --git a/help/workflow.md b/help/workflow.md new file mode 100644 --- /dev/null +++ b/help/workflow.md @@ -0,0 +1,74 @@ +WORKFLOW + +Use `seihou --help` for commands, `seihou COMMAND --help` for exact options, +and `seihou help` for the full topic index. Help topics explain workflows; +they are not a second command parser. + +FIRST USE + + seihou init + seihou install GIT-URL --module NAME + seihou vars NAME + seihou run NAME --dry-run --var project.name=my-app + seihou run NAME --var project.name=my-app + seihou status + + Init creates user configuration safely. Project-local artifacts can be run + without installing them. Modules and recipes use run; blueprints use agent + run; reusable prompts use prompt run. Only supply variables they declare. + See modules, recipes, blueprints, prompts, variables and git-repository. + +EXISTING PROJECTS + + seihou update TARGET + + Update fetches recorded remote sources/dependencies, reuses accepted inputs, + includes migrations and previews changes before confirmation. No prior install, + upgrade or migrate sequence is needed. With no TARGET, it selects all recorded + applications. `--dry-run` gives a separate preview. A `release to project` + preview hands managed starters to the project without rewriting bytes or + recreating deletion. Commit the seed receipts. Reverse seed adoption requires + explicit interactive keep/accept consent; force cannot supply it. See update + and migrations. + + seihou sync + + At the Git working-tree root, sync restores declared ignored directory links + from the committed manifest, including in fresh clones and linked worktrees. + It also executes explicitly repeatable checkout commands. No producer installation + is needed. No declarations means zero recorded work. A maintainer adopts changed + specs through ordinary update and commits them before teammates sync. + +INSPECTION AND RECOVERY + + seihou status Applied artifacts, pending migrations and local links + seihou status --full-prompt Include stored blueprint prompts without truncation + seihou diff Compare tracked managed files with disk + seihou agent upgrade TARGET --check + Diagnose update readiness without repairs + + Use `seihou agent upgrade TARGET` for assistance when ordinary update is + blocked. Older machine-specific manifests need explicit manifest upgrade; + path-shaped origins may need manifest repair-origins. See manifest and agent. + Preserve local edits; read a refusal's exact next action before using force. + +REMOVAL AND COMMITS + + seihou remove NAME --dry-run + seihou remove NAME + + Managed-file removal follows the module's removal declaration and protects + conflicts. Recorded seed-only/checkout-only owners need no custom spec; seed + retirement preserves files. Status/diff count seeds without content comparisons. + Review changes and commit portable manifest/config, real source directories + and ignore rules. Accepted link adoption can stage tracked-link removals. + Ignore discovery links and transient caches/traces. See modules and sync. + +SHELL COMPLETIONS + + seihou completions bash + seihou completions zsh + seihou completions fish + + These print shell setup scripts; inspect `seihou completions --help` for + installation examples. Extensions have independent help; see extensions. diff --git a/seihou-cli.cabal b/seihou-cli.cabal --- a/seihou-cli.cabal +++ b/seihou-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-cli -version: 0.10.1.0 +version: 0.11.0.0 synopsis: CLI for Seihou project scaffolding description: Command-line interface for Seihou, a composable project scaffolding @@ -21,6 +21,7 @@ data/blueprint-migration-prompt.md data/blueprint-prompt.md data/bootstrap-prompt.md + data/module-reference.md data/prompt-run-prompt.md data/setup-prompt.md data/upgrade-prompt.md @@ -28,15 +29,20 @@ help/blueprints.md help/config.md help/contexts.md + help/extensions.md help/git-repository.md help/kit.md help/manifest.md help/migrations.md help/modules.md help/prompts.md + help/recipes.md + help/registry.md + help/sync.md help/templating.md help/update.md help/variables.md + help/workflow.md source-repository head type: git @@ -135,7 +141,7 @@ generic-lens >=2.2 && <3, lens >=5.2 && <6, process >=1.6 && <2, - seihou-core ^>=0.10.1.0, + seihou-core ^>=0.11.0.0, streamly-core >=0.3 && <0.5, temporary >=1.3 && <2, text >=2.0 && <3, @@ -222,7 +228,7 @@ optparse-applicative >=0.18 && <1, process >=1.6 && <2, seihou-cli-internal, - seihou-core ^>=0.10.1.0, + seihou-core ^>=0.11.0.0, temporary >=1.3 && <2, text >=2.0 && <3, time >=1.12 && <2, @@ -281,6 +287,8 @@ Seihou.CLI.RepairOriginsE2ESpec Seihou.CLI.RunBlueprintRefusalSpec Seihou.CLI.SavePromptedSpec + Seihou.CLI.SeedRunE2ESpec + Seihou.CLI.SeedUpdateE2ESpec Seihou.CLI.SeihouBinary Seihou.CLI.SharedManifestE2ESpec Seihou.CLI.StatusSpec @@ -312,7 +320,7 @@ lens >=5.2 && <6, process >=1.6 && <2, seihou-cli-internal, - seihou-core ^>=0.10.1.0, + seihou-core ^>=0.11.0.0, streamly-core >=0.3 && <0.5, tasty >=1.4 && <2, tasty-hspec >=1.2 && <2, diff --git a/src-exe/Seihou/CLI/AgentRun.hs b/src-exe/Seihou/CLI/AgentRun.hs --- a/src-exe/Seihou/CLI/AgentRun.hs +++ b/src-exe/Seihou/CLI/AgentRun.hs @@ -13,7 +13,7 @@ where import Control.Exception (IOException, displayException, try) -import Control.Monad (when) +import Control.Monad (unless, when) import Data.FileEmbed (embedFile) import Data.Generics.Labels () import Data.Map.Strict qualified as Map @@ -24,6 +24,7 @@ import Data.Text.IO qualified as TIO import Data.Time (UTCTime) import Data.Time.Clock (getCurrentTime) +import Effectful.Exception qualified as E import Seihou.CLI.AgentCompletion ( AgentModelConfig (..), AgentProvider (..), @@ -57,7 +58,9 @@ prepareBlueprintExecution, varValueToText, ) +import Seihou.CLI.CheckoutSync (renderCheckoutPlan) import Seihou.CLI.Commands (BlueprintRunOpts (..)) +import Seihou.CLI.ManifestCapabilityUpgrade (prepareRecordedSeedOwnership) import Seihou.CLI.Shared ( deriveNamespace, formatVarError, @@ -66,11 +69,15 @@ unwrapConfig, ) import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName) -import Seihou.Composition.Plan (compileComposedPlan) +import Seihou.Composition.Plan (ComposedPlan (..), compileComposedPlan) import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts) +import Seihou.Core.Application (attachApplication, buildAppliedComposition, mkApplicationId, replaceAppliedComposition) import Seihou.Core.ArtifactOriginDetect (detectArtifactOrigin) +import Seihou.Core.Checkout +import Seihou.Core.CommandFingerprint (checkoutCommandsFromOperations) import Seihou.Core.Context (resolveContext) import Seihou.Core.Module (defaultSearchPaths, discoverRunnable) +import Seihou.Core.Seed (renderSeedOwnershipError, replaceSelectedSeedClaims) import Seihou.Core.Types import Seihou.Effect.BaselineStore (pruneBaselines) import Seihou.Effect.BaselineStoreInterp (runBaselineStore) @@ -87,10 +94,13 @@ import Seihou.Effect.Logger (logError, logInfo, logWarn) import Seihou.Effect.ManifestStore (readManifest, writeManifest) import Seihou.Effect.ManifestStoreInterp (runManifestStore) +import Seihou.Effect.ProcessInterp (runProcessIO) import Seihou.Engine.Baseline (manifestBaselineRefs, recordGeneratedBaselines) +import Seihou.Engine.Checkout import Seihou.Engine.Conflict (resolveConflicts) import Seihou.Engine.Diff (computeDiff) import Seihou.Engine.Execute (executePlan) +import Seihou.Engine.Seed import Seihou.Manifest.Types (currentManifestVersion, emptyManifest) import Seihou.Prelude import System.Directory (getCurrentDirectory) @@ -405,7 +415,7 @@ | (inst, m, dir) <- modulesInOrder ] planResult <- compileComposedPlan quads - (ops, _warnings, ownerMap) <- case planResult of + ComposedPlan {operations = ops, managedOwners = ownerMap, seedOwners = seedOwnerMap} <- case planResult of Left errs -> do logIO level $ logError "Errors compiling baseline plan:" mapM_ (logIO level . logError . (" " <>)) errs @@ -430,6 +440,32 @@ exitFailure Right m -> pure (fromMaybe (emptyManifest now) m) + case validateSeedRun manifest ops of + Left errors -> mapM_ (logIO level . logError . (^. #message)) errors >> exitFailure + Right () -> pure () + let appliedTarget = AppliedModuleTarget primary + applicationId = mkApplicationId appliedTarget [] + primaryOrigins = [(origin, m ^. #version) | (inst, m, origin) <- originedModules, inst ^. #module_ == primary] + (primaryOrigin, primaryVersion) = case primaryOrigins of pair : _ -> pair; [] -> (LocalOrigin (primary ^. #unModuleName), Nothing) + seedApplication = buildAppliedComposition appliedTarget primaryOrigin primaryVersion [] (Just namespace) context originedModules baseResolved now & #checkoutCommands .~ checkoutCommandsFromOperations ops + searchPaths <- defaultSearchPaths + let legacyPaths = Set.fromList [path | (path, receipt) <- Map.toAscList (manifest ^. #seeds), case receipt ^. #ownership of LegacySeedOwners apps -> Set.member applicationId apps || Map.member path seedOwnerMap; _ -> False] + preparedSeeds <- prepareRecordedSeedOwnership projectRoot searchPaths legacyPaths manifest + seedBase <- case preparedSeeds of Left err -> logIO level (logError err) >> exitFailure; Right prepared -> pure prepared + seedResult <- runEff $ runFilesystem $ planSeeds projectRoot seedBase seedOwnerMap ops + seedPlan <- case seedResult of + Left errors -> mapM_ (logIO level . logError . (^. #message)) errors >> exitFailure + Right plannedSeeds -> pure plannedSeeds + TIO.putStr (renderSeedPlan False seedPlan) + checkoutCandidate <- case replaceCheckoutApplications manifest [(seedApplication, ops)] of + Left err -> logIO level (logError (err ^. #message)) >> exitFailure + Right candidate -> pure candidate + checkoutResult <- runEff $ runFilesystem $ runProcessIO $ prepareCheckoutApplication projectRoot manifest checkoutCandidate ops + checkoutPlan <- case checkoutResult of + Left err -> logIO level (logError (err ^. #message)) >> exitFailure + Right candidate -> pure candidate + unless (checkoutApplicable checkoutPlan) (TIO.putStr (renderCheckoutPlan False checkoutPlan) >> exitFailure) + diff <- runEff $ runFilesystem $ runManifestStore manifestPath $ do let composedNames = Set.fromList $ @@ -471,40 +507,57 @@ ] skipPaths = [c ^. #path | (c, Skip) <- conflictResolved] excludePaths = Set.fromList (Map.keys keepRecords ++ skipPaths) - opsForExec = filter (not . opTargetsPath excludePaths) ops + opsForExec = filter (\op -> case op of SeedFileOp {} -> False; _ -> not (opTargetsPath excludePaths op)) ops 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) originedModules 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, - seeds = manifest ^. #seeds, - checkoutOutputs = manifest ^. #checkoutOutputs, - blueprintMigrations = manifest ^. #blueprintMigrations - } - writeManifest newManifest - pure (Right newManifest) + runProcessIO $ + 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) originedModules 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.mapWithKey (\path record -> if Map.member path baselineRecords || Map.member path keepRecords then attachApplication applicationId (Map.lookup path (manifest ^. #files)) record else record) (Map.unions [baselineRecords, keepRecords, cleanedFiles]), + applications = manifest ^. #applications, + recipe = manifest ^. #recipe, + blueprint = manifest ^. #blueprint, + seeds = manifest ^. #seeds, + checkoutOutputs = checkoutCandidate ^. #checkoutOutputs, + blueprintMigrations = manifest ^. #blueprintMigrations + } + actualSeedResult <- executeSeeds projectRoot applicationId now seedPlan seedBase + actualSeeds <- case actualSeedResult of + Left err -> liftIO (ioError (userError (T.unpack (err ^. #message)))) + Right receipts -> pure receipts + seededManifest <- case replaceSelectedSeedClaims (Set.singleton applicationId) actualSeeds (newManifest & #seeds .~ (seedBase ^. #seeds) & #applications .~ replaceAppliedComposition seedApplication (manifest ^. #applications)) of + Left err -> liftIO (ioError (userError (T.unpack (renderSeedOwnershipError err)))) + Right candidate -> pure candidate + actualCheckout <- prepareCheckoutPlan Reconcile ApplyDeclaration projectRoot manifest checkoutCandidate [] + checked <- case actualCheckout of + Left err -> E.throwIO (userError (T.unpack (err ^. #message))) + Right plan | checkoutApplicable plan -> pure plan + Right plan -> E.throwIO (userError (T.unpack (renderCheckoutPlan False plan))) + links <- applyCheckoutPlan ApplyDeclaration projectRoot checked + case links ^. #failure of + Just err -> E.throwIO (userError (T.unpack (err ^. #message))) + Nothing -> pure () + writeManifest seededManifest `E.onException` (rollbackCheckout projectRoot (links ^. #undo) >> pure ()) + pure (Right seededManifest) newManifest <- case generationAttempt of Left err -> do diff --git a/src-exe/Seihou/CLI/Assist.hs b/src-exe/Seihou/CLI/Assist.hs --- a/src-exe/Seihou/CLI/Assist.hs +++ b/src-exe/Seihou/CLI/Assist.hs @@ -46,7 +46,8 @@ renderPrompt :: AgentContext -> Text renderPrompt ctx = substitute - [ ("cwd", ctx ^. #cwd), + [ ("module_reference", TE.decodeUtf8 $(embedFile "data/module-reference.md")), + ("cwd", ctx ^. #cwd), ("seihou_project_state", formatSeihouProjectState ctx), ("manifest_state", formatManifestState ctx), ("module_dhall_state", formatModuleDhallState ctx), diff --git a/src-exe/Seihou/CLI/Bootstrap.hs b/src-exe/Seihou/CLI/Bootstrap.hs --- a/src-exe/Seihou/CLI/Bootstrap.hs +++ b/src-exe/Seihou/CLI/Bootstrap.hs @@ -47,7 +47,8 @@ renderPrompt :: AgentContext -> BootstrapOpts -> Text renderPrompt ctx bootstrapOpts = substitute - [ ("cwd", ctx ^. #cwd), + [ ("module_reference", TE.decodeUtf8 $(embedFile "data/module-reference.md")), + ("cwd", ctx ^. #cwd), ("seihou_project_state", formatSeihouProjectState ctx), ("manifest_state", formatManifestState ctx), ("module_dhall_state", formatModuleDhallState ctx), diff --git a/src-exe/Seihou/CLI/Commands.hs b/src-exe/Seihou/CLI/Commands.hs --- a/src-exe/Seihou/CLI/Commands.hs +++ b/src-exe/Seihou/CLI/Commands.hs @@ -1738,7 +1738,8 @@ pretty ("run Run an agent-driven blueprint" :: String), pretty ("migrate Run ordered library-upgrade blueprint migrations" :: String), pretty ("upgrade Upgrade a module with an agent that repairs manifest state" :: String), - pretty ("models List known agent models" :: String) + pretty ("models List known agent models" :: String), + pretty ("config Inspect resolved per-command agent settings" :: String) ] ] ) @@ -2375,13 +2376,13 @@ info (syncParser <**> helper) ( fullDesc - <> progDesc "Restore declared local links for this checkout" - <> footer "Run at the Git working-tree root. No producer installation is needed. If links have not been declared yet, run seihou update TARGET once and commit the resulting manifest; later clones need only seihou sync." + <> progDesc "Restore declared checkout links and repeatable commands" + <> footer "Run at the Git working-tree root after receiving the committed manifest and source assets. Executes module-declared repeatable shell commands with your permissions. Does not fetch producers or update project state. Maintainers adopt changed specifications with seihou update ." ) where syncParser = Sync <$> ( SyncOpts - <$> switch (long "dry-run" <> help "Show planned links without changing anything") + <$> switch (long "dry-run" <> help "Show recorded links and commands without executing effects") <*> switch (long "json" <> help "Print one JSON report") ) diff --git a/src-exe/Seihou/CLI/Help.hs b/src-exe/Seihou/CLI/Help.hs --- a/src-exe/Seihou/CLI/Help.hs +++ b/src-exe/Seihou/CLI/Help.hs @@ -42,6 +42,11 @@ 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 "workflow" "Choose commands for generation, updates, and recovery" workflowContent, + HelpTopic "sync" "Set up and restore local checkout links" syncContent, + HelpTopic "recipes" "Compose existing modules into one named application" recipesContent, + HelpTopic "registry" "Publish and validate multi-artifact repository metadata" registryContent, + HelpTopic "extensions" "Run external extensions and find their help" extensionsContent, HelpTopic "update" "Safely update recorded project applications" updateContent ] @@ -83,6 +88,21 @@ updateContent :: Text updateContent = $(embedStringFile "help/update.md") + +workflowContent :: Text +workflowContent = $(embedStringFile "help/workflow.md") + +syncContent :: Text +syncContent = $(embedStringFile "help/sync.md") + +recipesContent :: Text +recipesContent = $(embedStringFile "help/recipes.md") + +registryContent :: Text +registryContent = $(embedStringFile "help/registry.md") + +extensionsContent :: Text +extensionsContent = $(embedStringFile "help/extensions.md") helpCommandParser :: Parser HelpCommand helpCommandParser = diff --git a/src-exe/Seihou/CLI/Remove.hs b/src-exe/Seihou/CLI/Remove.hs --- a/src-exe/Seihou/CLI/Remove.hs +++ b/src-exe/Seihou/CLI/Remove.hs @@ -13,8 +13,11 @@ import Data.Time.Clock (getCurrentTime) import Seihou.CLI.CheckoutSync (renderCheckoutPlan) import Seihou.CLI.Commands (RemoveOpts (..)) +import Seihou.CLI.ManifestCapabilityUpgrade (prepareRecordedSeedOwnership) import Seihou.CLI.Style (bold, dim, green, useColor, yellow) +import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName) import Seihou.Core.Checkout +import Seihou.Core.Module (defaultSearchPaths) import Seihou.Core.Types import Seihou.Effect.FilesystemInterp (runFilesystem) import Seihou.Effect.ManifestStore (readManifest, writeManifest) @@ -34,7 +37,7 @@ -- Read the manifest manifestResult <- runEff $ runFilesystem $ runManifestStore manifestPath readManifest - manifest <- case manifestResult of + originalManifest <- case manifestResult of Left err -> do TIO.putStrLn $ "Error reading manifest: " <> err exitFailure @@ -43,7 +46,13 @@ exitFailure Right (Just m) -> pure m - case selectCheckoutRemoval manifest modName (opts ^. #application) of + root <- getCurrentDirectory + paths <- defaultSearchPaths + let matchingApps = Set.fromList [app ^. #applicationId | app <- originalManifest ^. #applications, maybe True (== app ^. #applicationId) (opts ^. #application), state <- app ^. #instances, modName == state ^. #name || modName == qualifiedName (ModuleInstance (state ^. #name) (state ^. #parentVars))] + legacyPaths = Set.fromList [path | (path, receipt) <- Map.toAscList (originalManifest ^. #seeds), LegacySeedOwners apps <- [receipt ^. #ownership], not (Set.null (apps `Set.intersection` matchingApps))] + prepared <- prepareRecordedSeedOwnership root paths legacyPaths originalManifest + manifest <- case prepared of Left err -> TIO.putStrLn err >> exitFailure; Right candidate -> pure candidate + case selectRecordedRemoval manifest modName (opts ^. #application) of Left err -> TIO.putStrLn (err ^. #message) >> exitFailure Right (Just selected) -> handleCheckoutRemoval opts manifest selected >> exitWith ExitSuccess Right Nothing -> pure () @@ -144,6 +153,7 @@ -- | Display a single removal operation. displayOp :: Bool -> RemovalOp -> IO () +displayOp _ (KeepSeedOp path) = TIO.putStrLn (" Keep " <> T.pack path <> " (seed file; owned by the project)") displayOp c (DeleteFileOp path RFSafe) = TIO.putStrLn $ " " <> applyColor c green "Delete" <> " " <> T.pack path <> applyColor c dim " (unchanged)" displayOp c (DeleteFileOp path RFConflict) = @@ -211,6 +221,8 @@ handleCheckoutRemoval opts manifest selected = do root <- getCurrentDirectory let candidate = selected ^. #candidateManifest + retiredSeeds = [path | (path, receipt) <- Map.toAscList (manifest ^. #seeds), case receipt ^. #ownership of KnownSeedOwners owners -> Set.member (selected ^. #instanceName) (Map.findWithDefault Set.empty (selected ^. #applicationId) owners); _ -> False] + mapM_ (\path -> TIO.putStrLn (" Keep " <> T.pack path <> " (seed file; owned by the project)")) (take 5 retiredSeeds) checked <- runEff $ runFilesystem $ runProcessIO $ prepareCheckoutPlan Reconcile ApplyDeclaration root manifest candidate [] plan <- case checked of Left err -> TIO.putStrLn (err ^. #message) >> exitFailure @@ -261,7 +273,9 @@ _ <- runEff $ runFilesystem $ rollbackCheckout root (applied ^. #undo) TIO.putStrLn ("Removal failed: " <> T.pack (show err)) exitFailure - Right () -> TIO.putStrLn ("Removed checkout ownership for " <> selected ^. #instanceName . #unModuleName <> ".") + Right () -> do + unless (null retiredSeeds) $ TIO.putStrLn ("Retired " <> T.pack (show (length retiredSeeds)) <> " seed claims; project files were kept.") + TIO.putStrLn ("Removed recorded ownership for " <> selected ^. #instanceName . #unModuleName <> ".") where removalDestination (DeleteFileOp path _) = Just path removalDestination (StripSectionOp path) = Just path diff --git a/src-exe/Seihou/CLI/Run.hs b/src-exe/Seihou/CLI/Run.hs --- a/src-exe/Seihou/CLI/Run.hs +++ b/src-exe/Seihou/CLI/Run.hs @@ -28,6 +28,7 @@ import Seihou.CLI.Commands (RunOpts (..)) import Seihou.CLI.CommitMessage (generateCommitMessage) import Seihou.CLI.Git (gitAdd, gitCheckIgnore, gitCommit, gitDiffCached, isGitRepo) +import Seihou.CLI.ManifestCapabilityUpgrade (prepareRecordedSeedOwnership) import Seihou.CLI.ManifestGuard ( blockingChecks, checkAppliedArtifactsFor, @@ -47,16 +48,18 @@ import Seihou.CLI.Shared (deriveNamespace, formatBlueprintRefusal, formatVarError, logIO, resolveAppliedArtifactDir, toVarNameMap, unwrapConfig) import Seihou.CLI.Style (bold, dim, formatPlanViewColor, green, magenta, red, useColor, yellow) import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName) -import Seihou.Composition.Plan (compileComposedPlan) +import Seihou.Composition.Plan (ComposedPlan (..), compileComposedPlan) import Seihou.Composition.Recipe (expandRecipe) import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts) import Seihou.Core.Application (attachApplication, buildAppliedComposition, mkApplicationId, replaceAppliedComposition) import Seihou.Core.ArtifactOriginDetect (detectArtifactOrigin) import Seihou.Core.ArtifactRef (renderArtifactRefError) import Seihou.Core.Checkout +import Seihou.Core.CommandFingerprint (checkoutCommandsFromOperations, isCheckoutCommand) import Seihou.Core.Context (resolveContext) import Seihou.Core.Migration (MigrationPlan (..)) import Seihou.Core.Module (defaultSearchPaths, discoverRunnable) +import Seihou.Core.Seed (renderSeedOwnershipError, replaceSelectedSeedClaims) import Seihou.Core.Types import Seihou.Core.Variable (diagnoseResolution) import Seihou.Core.Version (renderVersion) @@ -79,6 +82,7 @@ import Seihou.Engine.Diff (computeDiff) import Seihou.Engine.Execute (executePlan) import Seihou.Engine.Preview (buildPreview) +import Seihou.Engine.Seed import Seihou.Fzf (FzfResult (..), detectFzfConfig, isFzfUsable) import Seihou.Fzf.Selector (selectModule) import Seihou.Interaction.Confirm (confirmDefaults) @@ -239,7 +243,7 @@ | (inst, m, dir) <- modulesInOrder ] planResult <- compileComposedPlan quads - (ops, warnings, ownerMap) <- case planResult of + ComposedPlan {operations = ops, warnings, managedOwners = ownerMap, seedOwners = seedOwnerMap} <- case planResult of Left errs -> do logIO level $ do logError "Errors compiling plan:" @@ -276,6 +280,10 @@ exitFailure Right m -> pure (fromMaybe (emptyManifest now) m) + case validateSeedRun initialManifest opsFiltered of + Left errors -> mapM_ (TIO.putStrLn . (^. #message)) errors >> exitFailure + Right () -> pure () + let composedModuleNames = Set.fromList [m ^. #name | (_, m, _) <- modulesInOrder] @@ -289,6 +297,10 @@ -- touch must not block it. projectRoot <- getCurrentDirectory searchPaths <- defaultSearchPaths + earlySeedResult <- runEff $ runFilesystem $ planSeeds projectRoot initialManifest seedOwnerMap opsFiltered + case earlySeedResult of + Left errors -> mapM_ (TIO.putStrLn . (^. #message)) errors >> exitFailure + Right _ -> pure () guardChecks <- checkAppliedArtifactsFor projectRoot searchPaths (Just composedModuleNames) initialManifest enforceArtifactGuard (runOpts ^. #allowDowngrade) (blockingChecks guardChecks) @@ -332,6 +344,17 @@ let declarationApplication = buildAppliedComposition appliedTarget targetOrigin targetVersion additional (Just namespace) context originedModules resolved now + let selectedSeedPaths = Set.fromList [path | (path, receipt) <- Map.toAscList (manifest ^. #seeds), case receipt ^. #ownership of LegacySeedOwners apps -> Set.member currentApplicationId apps || Map.member path seedOwnerMap; _ -> False] + seedPrepared <- prepareRecordedSeedOwnership projectRoot searchPaths selectedSeedPaths manifest + seedBase <- case seedPrepared of + Left err -> TIO.putStrLn err >> exitFailure + Right candidate -> pure candidate + seedResult <- runEff $ runFilesystem $ planSeeds projectRoot seedBase seedOwnerMap opsFiltered + seedPlan <- case seedResult of + Left errors -> mapM_ (TIO.putStrLn . (^. #message)) errors >> exitFailure + Right plannedSeeds -> pure plannedSeeds + TIO.putStr (renderSeedPlan (runOpts ^. #diff) seedPlan) + checkoutCandidate <- case replaceCheckoutApplications manifest [(declarationApplication, opsFiltered)] of Left err -> TIO.putStrLn (err ^. #message) >> exitFailure Right candidate -> pure candidate @@ -362,7 +385,7 @@ allVarValues = Map.unions [Map.map (^. #value) vs | vs <- Map.elems resolved] - preview = buildPreview opsFiltered (Just diff) ownerMap + preview = buildPreview (filter (\case SeedFileOp {} -> False; _ -> True) opsFiltered) (Just diff) ownerMap -- 6. Handle --dry-run: show plan view and exit if runOpts ^. #dryRun @@ -423,7 +446,7 @@ ] skipPaths = [c ^. #path | (c, Skip) <- conflictResolved] excludePaths = Set.fromList (Map.keys keepRecords ++ skipPaths) - opsForExec = filter (not . opTargetsPath excludePaths) opsFiltered + opsForExec = filter (\op -> case op of SeedFileOp {} -> False; _ -> not (opTargetsPath excludePaths op)) opsFiltered -- Execute the plan (excluding kept/skipped files), capture the -- exact post-execution baselines, and only then publish the @@ -470,6 +493,8 @@ ( appliedCompositionWithoutReceipts & #commandReceipts .~ candidateCommandReceipts + & #checkoutCommands + .~ checkoutCommandsFromOperations ops ) applicationDestinations = Set.fromList [path | Just path <- map operationDestination opsFiltered] @@ -496,6 +521,13 @@ checkoutOutputs = checkoutCandidate ^. #checkoutOutputs, blueprintMigrations = manifest ^. #blueprintMigrations } + actualSeedResult <- executeSeeds projectRoot currentApplicationId now seedPlan seedBase + actualSeeds <- case actualSeedResult of + Left err -> E.throwIO (userError (T.unpack (err ^. #message))) + Right receipts -> pure receipts + seededManifest <- case replaceSelectedSeedClaims (Set.singleton currentApplicationId) actualSeeds (newManifest & #seeds .~ (seedBase ^. #seeds)) of + Left err -> E.throwIO (userError (T.unpack (renderSeedOwnershipError err))) + Right candidate -> pure candidate actual <- prepareCheckoutPlan Reconcile ApplyDeclaration projectRoot manifest checkoutCandidate [] checked <- case actual of Left err -> E.throwIO (userError (T.unpack (err ^. #message))) @@ -505,8 +537,8 @@ case links ^. #failure of Just err -> E.throwIO (userError (T.unpack (err ^. #message))) Nothing -> pure () - writeManifest newManifest `E.onException` (rollbackCheckout projectRoot (links ^. #undo) >> pure ()) - pure (Right newManifest) + writeManifest seededManifest `E.onException` (rollbackCheckout projectRoot (links ^. #undo) >> pure ()) + pure (Right seededManifest) newManifest <- case generationAttempt of Left err -> do @@ -569,6 +601,9 @@ <> T.pack (show (commandError ^. #exitCode)) <> "): " <> plannedCommandText (commandError ^. #command) + if isCheckoutCommand (commandError ^. #command . #operation) + then TIO.putStrLn "Accepted checkout declarations remain recorded. Correct the failure and retry seihou sync; ordinary application commands are not retried by sync." + else TIO.putStrLn ("Ordinary application commands are not retried by sync. Correct the failure and rerun seihou run " <> modName ^. #unModuleName <> "; accepted checkout declarations remain recorded.") exitFailure let finalCommandReceipts = @@ -595,6 +630,7 @@ let filesToStage = map (^. #path) (diff ^. #new) ++ map (^. #path) (diff ^. #modified) + ++ [plannedSeed ^. #dest | plannedSeed <- seedPlan, plannedSeed ^. #decision == SeedWrite, Just receipt <- [Map.lookup (plannedSeed ^. #dest) (newManifest ^. #seeds)], receipt ^. #outcome == SeedCreated] ++ [manifestPath, baselineDir] inGit <- runEff $ runProcessIO $ isGitRepo if inGit @@ -636,6 +672,7 @@ exitFailure printWarning :: LogLevel -> CompositionWarning -> IO () +printWarning level (SeedContentIgnored path supplier other) = printSeedWarning level path supplier other printWarning level (FileOverwritten path overwritten overwriter) = logIO level . logWarn $ "Warning: " @@ -898,3 +935,9 @@ | (inst, m, origin) <- modulesInOrder ] in filtered ++ new + +printSeedWarning :: LogLevel -> FilePath -> ModuleName -> ModuleName -> IO () +printSeedWarning level path supplier other = + logIO level $ + logWarn $ + "Seed '" <> T.pack path <> "' uses the first supplier " <> supplier ^. #unModuleName <> "; ignored different proposed content from " <> other ^. #unModuleName diff --git a/src-exe/Seihou/CLI/Setup.hs b/src-exe/Seihou/CLI/Setup.hs --- a/src-exe/Seihou/CLI/Setup.hs +++ b/src-exe/Seihou/CLI/Setup.hs @@ -46,7 +46,8 @@ renderPrompt :: AgentContext -> Text renderPrompt ctx = substitute - [ ("cwd", ctx ^. #cwd), + [ ("module_reference", TE.decodeUtf8 $(embedFile "data/module-reference.md")), + ("cwd", ctx ^. #cwd), ("seihou_project_state", formatSeihouProjectState ctx), ("manifest_state", formatManifestState ctx), ("module_dhall_state", formatModuleDhallState ctx), diff --git a/src-exe/Seihou/CLI/Status.hs b/src-exe/Seihou/CLI/Status.hs --- a/src-exe/Seihou/CLI/Status.hs +++ b/src-exe/Seihou/CLI/Status.hs @@ -4,9 +4,12 @@ where import Control.Exception (SomeException, try) +import Control.Monad (when) import Data.Generics.Labels () import Data.Maybe (maybeToList) +import Data.Text qualified as T import Data.Text.IO qualified as TIO +import Seihou.CLI.CheckoutSync (checkoutAdoptionNotices) import Seihou.CLI.Commands (StatusOpts (..)) import Seihou.CLI.ManifestGuard (ArtifactCheck, checkAppliedArtifacts, checkAppliedBlueprint) import Seihou.CLI.Outdated (checkInstalledModulesForUpdates) @@ -57,7 +60,11 @@ checkout <- runEff $ runFilesystem $ runProcessIO $ prepareCheckoutPlan Rebuild SyncIgnoredOnly root manifest manifest [] case checkout of Left err -> TIO.putStrLn ("Checkout outputs: " <> err ^. #message) - Right plan -> TIO.putStr (formatCheckoutStatus plan) + Right plan -> do + TIO.putStr (formatCheckoutStatus plan) + mapM_ TIO.putStrLn (checkoutAdoptionNotices manifest) + let checkoutCommandCount = sum (map (length . (^. #checkoutCommands)) (manifest ^. #applications)) + when (checkoutCommandCount > 0) (TIO.putStrLn (T.pack (show checkoutCommandCount) <> " repeatable checkout commands declared; run seihou sync to execute them.")) mEntries <- if opts ^. #statusCheckUpdates && not (null (manifest ^. #modules)) then fetchUpdateEntries diff --git a/src-exe/Seihou/CLI/Sync.hs b/src-exe/Seihou/CLI/Sync.hs --- a/src-exe/Seihou/CLI/Sync.hs +++ b/src-exe/Seihou/CLI/Sync.hs @@ -6,6 +6,7 @@ import Data.Maybe (isJust) import Data.Text.IO qualified as TIO import Seihou.CLI.CheckoutSync +import Seihou.CLI.CommandExecution (commandOutcomesFailed) import Seihou.CLI.Commands (SyncOpts (..)) import Seihou.Core.Checkout import Seihou.Engine.Checkout (CheckoutExecution (..)) @@ -13,17 +14,18 @@ import System.Exit (exitFailure) handleSync :: SyncOpts -> IO () -handleSync opts = do - result <- runCheckoutSync (opts ^. #dryRun) - case result of - Left err -> do - if opts ^. #json - then LBS.putStrLn (A.encode (checkoutFailureJSON (opts ^. #dryRun) err)) - else TIO.putStrLn (err ^. #message) - exitFailure - Right report -> do - if opts ^. #json - then LBS.putStrLn (A.encode (checkoutReportJSON report)) - else do - TIO.putStr (renderCheckoutReport report) - if not (checkoutApplicable (report ^. #plan)) || isJust (report ^. #execution . #failure) then exitFailure else pure () +handleSync opts = runCheckoutSync (opts ^. #dryRun) >>= either (failSync opts) (emitReport opts) + +failSync :: SyncOpts -> CheckoutError -> IO a +failSync opts err = do + if opts ^. #json + then LBS.putStrLn (A.encode (checkoutFailureJSON (opts ^. #dryRun) err)) + else TIO.putStrLn (err ^. #message) + exitFailure + +emitReport :: SyncOpts -> CheckoutSyncResult -> IO () +emitReport opts report = do + if opts ^. #json + then LBS.putStrLn (A.encode (checkoutReportJSON report)) + else TIO.putStr (renderCheckoutReport report) + if not (checkoutApplicable (report ^. #plan)) || isJust (report ^. #execution . #failure) || commandOutcomesFailed (map snd (report ^. #commandOutcomes)) then exitFailure else pure () diff --git a/src-exe/Seihou/CLI/Update.hs b/src-exe/Seihou/CLI/Update.hs --- a/src-exe/Seihou/CLI/Update.hs +++ b/src-exe/Seihou/CLI/Update.hs @@ -177,6 +177,7 @@ failInteraction :: UpdateOpts -> InteractionError -> IO a failInteraction opts err = case err of + SeedAdoptionRequiresInteraction paths -> failCli opts "seed_adoption_requires_interaction" ("Seed adoption requires explicit consent for: " <> T.intercalate ", " (map T.pack (Set.toAscList paths)) <> ". Run an interactive seihou update to choose keep or accept; --force does not consent to adoption.") InteractionRequired paths -> failCli opts diff --git a/src/Seihou/CLI/CheckoutSync.hs b/src/Seihou/CLI/CheckoutSync.hs --- a/src/Seihou/CLI/CheckoutSync.hs +++ b/src/Seihou/CLI/CheckoutSync.hs @@ -11,13 +11,16 @@ where import Control.Exception (IOException, displayException, try) +import Control.Monad (forM) import Data.Aeson qualified as A import Data.ByteString.Lazy qualified as LBS import Data.Generics.Labels () +import Data.List (sortOn) import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Text.Encoding qualified as TE -import Seihou.CLI.ApplicationDisplay (appliedTargetName) +import Seihou.CLI.CommandExecution +import Seihou.CLI.Update.Recovery (pendingUpdateRecovery) import Seihou.Core.Checkout import Seihou.Core.Types import Seihou.Effect.Filesystem hiding (CreateDirectoryLink) @@ -33,7 +36,9 @@ dryRun :: !Bool, plan :: !CheckoutPlan, execution :: !CheckoutExecution, - notices :: ![Text] + notices :: ![Text], + commands :: ![(ApplicationId, PlannedCommand)], + commandOutcomes :: ![(ApplicationId, CommandOutcome)] } deriving stock (Eq, Show, Generic) @@ -50,39 +55,43 @@ case safe of Left err -> pure (Left err) Right () -> do - bytes <- readFileText (root ".seihou/manifest.json") - case manifestFromJSON (LBS.fromStrict (TE.encodeUtf8 bytes)) of - Left err -> pure (Left (checkoutError "checkout_manifest_invalid" (T.pack err <> "; use seihou manifest upgrade for an older manifest, or a newer seihou for a newer schema"))) - Right manifest -> do - planned <- prepareCheckoutPlan Rebuild SyncIgnoredOnly root manifest manifest [] - case planned of - Left err -> pure (Left err) - Right plan -> do - execution <- if dryRun then pure (CheckoutExecution Map.empty [] Nothing) else applyCheckoutPlan SyncIgnoredOnly root plan - let notices = checkoutAdoptionNotices manifest - pure (Right (CheckoutSyncResult root dryRun plan execution notices)) + pending <- liftIO (pendingUpdateRecovery root) + if pending + then pure (Left (checkoutError "checkout_update_recovery_pending" "An interrupted update needs recovery. Run seihou update --dry-run; its entry path recovers the prior transaction's files/index before previewing any new update. Then retry seihou sync.")) + else do + bytes <- readFileText (root ".seihou/manifest.json") + case manifestFromJSON (LBS.fromStrict (TE.encodeUtf8 bytes)) of + Left err -> pure (Left (checkoutError "checkout_manifest_invalid" (T.pack err <> "; use seihou manifest upgrade for an older manifest, or a newer seihou for a newer schema"))) + Right manifest -> do + let commands = [(application ^. #applicationId, command) | application <- sortOn (^. #applicationId) (manifest ^. #applications), command <- planCheckoutCommands (application ^. #checkoutCommands) ^. #commands] + readiness <- forM commands $ \(application, command) -> case command ^. #operation of + RunCommandOp {workDir, moduleName} -> do + ready <- liftIO (checkCheckoutWorkDir root workDir) + pure (first (checkoutError "checkout_command_workdir" . (("application " <> application ^. #unApplicationId <> ", instance " <> moduleName ^. #unModuleName <> ": ") <>)) ready) + _ -> pure (Right ()) + case sequence readiness of + Left err -> pure (Left err) + Right _ -> do + planned <- prepareCheckoutPlan Rebuild SyncIgnoredOnly root manifest manifest [] + case planned of + Left err -> pure (Left err) + Right plan -> do + execution <- if dryRun then pure (CheckoutExecution Map.empty [] Nothing) else applyCheckoutPlan SyncIgnoredOnly root plan + outcomes <- if dryRun || not (checkoutApplicable plan) || execution ^. #failure /= Nothing then pure [] else executeCommandOutcomes (CommandPlan (map snd commands)) + let notices = checkoutAdoptionNotices manifest + pure (Right (CheckoutSyncResult root dryRun plan execution notices commands (zip (map fst commands) outcomes))) pure $ case result of Left err -> Left (checkoutError "checkout_io_failed" ("cannot inspect checkout: " <> T.pack (displayException err))) Right value -> value --- | Suggest a check of recorded targets, without claiming that their remotes --- necessarily contain a declaring release or inferring intent from receipts. +-- | Absence of declarations is zero recorded work, never authority to update. checkoutAdoptionNotices :: Manifest -> [Text] checkoutAdoptionNotices manifest - | not (Map.null (manifest ^. #checkoutOutputs)) = [] - | null (manifest ^. #applications) = - ["No links are declared in this manifest. Apply a module that declares checkout links, then commit its manifest and source files."] - | otherwise = - [ "No links are declared in this manifest. Sync can restore links after a declaring module update has been adopted.", - "Check for an update using the recorded target below; review its preview before accepting:" - ] - <> map (" seihou update " <>) targets - <> ["Commit the adopted manifest and source files. Future clones need only seihou sync; no producer installation is required."] + | Map.null (manifest ^. #checkoutOutputs) && commandCount == 0 = + ["No checkout effects are recorded. Nothing to sync."] + | otherwise = [] where - targets = Map.keys (Map.fromList [(shellWord (appliedTargetName (app ^. #target)), ()) | app <- manifest ^. #applications]) - shellWord word - | T.all (\c -> c `elem` ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_." :: String)) word = word - | otherwise = "'" <> T.replace "'" "'\\''" word <> "'" + commandCount = sum (map (length . (^. #checkoutCommands)) (manifest ^. #applications)) checkoutFailureJSON :: Bool -> CheckoutError -> A.Value checkoutFailureJSON dryRun err = A.object ["mode" A..= mode dryRun, "outputs" A..= ([] :: [A.Value]), "errors" A..= [errorJSON err], "summary" A..= A.object ["planned" A..= counts [], "applied" A..= counts []]] @@ -94,6 +103,7 @@ "root" A..= (result ^. #root), "applicable" A..= checkoutApplicable (result ^. #plan), "outputs" A..= map entryJSON entries, + "commands" A..= map commandJSON (result ^. #commands), "errors" A..= map errorJSON (maybe [] pure (result ^. #execution . #failure)), "notices" A..= (result ^. #notices), "summary" @@ -104,6 +114,10 @@ ] where entries = result ^. #plan . #entries + commandJSON (application, planned) = + let outcome = lookupOutcome application planned + in A.object ["application" A..= (application ^. #unApplicationId), "instance" A..= commandOwner planned, "command" A..= commandText planned, "outcome" A..= maybe (if result ^. #dryRun then "would-run" else "not-run") outcomeText outcome, "exitCode" A..= (outcome >>= (^. #exitCode)), "stdout" A..= maybe "" (^. #stdout) outcome, "stderr" A..= maybe "" (^. #stderr) outcome] + lookupOutcome application planned = lookup (application, planned) [((owner, outcome ^. #command), outcome) | (owner, outcome) <- result ^. #commandOutcomes] entryJSON entry = A.object [ "destination" A..= (entry ^. #dest), @@ -168,6 +182,7 @@ renderCheckoutReport report = renderCheckoutPlan (report ^. #dryRun) displayedPlan <> summary + <> renderCommands report <> T.unlines (report ^. #notices) <> T.unlines (map (^. #message) (maybe [] pure (report ^. #execution . #failure))) where @@ -211,16 +226,18 @@ <> " unchanged.\n" renderCheckoutStatus :: CheckoutPlan -> Text -renderCheckoutStatus plan = - let affected = filter ((/= UnchangedLink) . (^. #action)) (plan ^. #entries) - count = length affected - in "Checkout outputs: " - <> T.pack (show (length (plan ^. #entries))) - <> " declared, " - <> T.pack (show count) - <> " need attention.\n" - <> T.concat [" " <> T.pack (entry ^. #dest) <> ": " <> reason entry <> "\n" | entry <- take 10 affected] - <> (if count > 10 then " … " <> T.pack (show (count - 10)) <> " more affected paths\n" else "") +renderCheckoutStatus plan + | null (plan ^. #entries) = "Checkout outputs: none declared.\n" + | otherwise = + let affected = filter ((/= UnchangedLink) . (^. #action)) (plan ^. #entries) + count = length affected + in "Checkout outputs: " + <> T.pack (show (length (plan ^. #entries))) + <> " declared, " + <> T.pack (show count) + <> " need attention.\n" + <> T.concat [" " <> T.pack (entry ^. #dest) <> ": " <> reason entry <> "\n" | entry <- take 10 affected] + <> (if count > 10 then " … " <> T.pack (show (count - 10)) <> " more affected paths\n" else "") where reason entry = case entry ^. #errors of err : _ -> err ^. #message @@ -232,3 +249,38 @@ PreserveModified -> "modified entry preserved" UnchangedLink -> "correct" RefusedLink -> "repair refused; inspect this path" + +commandOwner :: PlannedCommand -> Text +commandOwner planned = case planned ^. #operation of + RunCommandOp {moduleName} -> moduleName ^. #unModuleName + _ -> "" + +commandText :: PlannedCommand -> Text +commandText planned = case planned ^. #operation of + RunCommandOp {command} -> command + _ -> "" + +outcomeText :: CommandOutcome -> Text +outcomeText outcome = case outcome ^. #status of + CommandSucceeded -> "succeeded" + CommandFailed -> "failed" + CommandSkipped -> "skipped" + CommandNotRun -> "not-run" + +renderCommands :: CheckoutSyncResult -> Text +renderCommands report = + T.concat + [ let outcome = lookup (application, planned) [((owner, value ^. #command), value) | (owner, value) <- report ^. #commandOutcomes] + label = if report ^. #dryRun then "would-run" else maybe "not-run" outcomeText outcome + in label + <> " checkout command [" + <> application ^. #unApplicationId + <> "/" + <> commandOwner planned + <> "]: " + <> commandText planned + <> "\n" + <> maybe "" (\value -> maybe "" (\code -> " exit " <> T.pack (show code) <> "\n") (value ^. #exitCode) <> value ^. #stdout <> value ^. #stderr) outcome + | (application, planned) <- report ^. #commands + ] + <> if commandOutcomesFailed (map snd (report ^. #commandOutcomes)) then "Checkout command failed. Completed local effects remain; retry with seihou sync after correcting the failure.\n" else "" diff --git a/src/Seihou/CLI/CommandExecution.hs b/src/Seihou/CLI/CommandExecution.hs --- a/src/Seihou/CLI/CommandExecution.hs +++ b/src/Seihou/CLI/CommandExecution.hs @@ -6,22 +6,36 @@ CommandPlanSummary (..), CommandExecutionError (..), planCommands, + planCheckoutCommands, summarizeCommandPlan, executeCommandPlan, executeCommandPlanWithOutput, finalizeCommandReceipts, + CommandOutcome (..), + CommandOutcomeStatus (..), + executeCommandOutcomes, + commandOutcomesFailed, + checkCheckoutWorkDir, ) where +import Control.Exception (IOException, displayException, try) +import Control.Monad (forM, forM_, when) import Data.Generics.Labels () +import Data.List (find) import Data.Map.Strict qualified as Map -import Data.Maybe (mapMaybe) +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Text qualified as T import Data.Time (UTCTime) -import Seihou.Core.CommandFingerprint (fingerprintCommand) +import Effectful.Exception qualified as E +import Seihou.Core.CommandFingerprint (checkoutCommandOperation, fingerprintCommand, isCheckoutCommand) +import Seihou.Core.Path (validateCanonicalProjectPath) import Seihou.Core.Types import Seihou.Effect.Process (Process, runProcess) import Seihou.Prelude +import System.Directory qualified as Directory import System.Exit (ExitCode (..)) +import System.FilePath qualified as Path -- | Whether a command phase runs every declaration, only declarations that -- lack a successful receipt, or no declarations. @@ -85,11 +99,22 @@ let disposition = case policy of RunAllCommands -> CommandWillRun RunChangedCommands - | Map.member fingerprint priorReceipts -> CommandSkippedUnchanged + | not (isCheckoutCommand operation), Map.member fingerprint priorReceipts -> CommandSkippedUnchanged | otherwise -> CommandWillRun DisableCommands -> CommandSkippedDisabled pure PlannedCommand {operation, fingerprint, disposition} +-- | Resolved checkout instructions always run on explicit sync. This boundary +-- accepts neither a receipt map nor an application command policy. Conversion +-- produces only RunCommandOp, for which fingerprintCommand always returns Just. +planCheckoutCommands :: [CheckoutCommand] -> CommandPlan +planCheckoutCommands declarations = CommandPlan (mapMaybe planned declarations) + where + planned declaration = do + let operation = checkoutCommandOperation declaration + fingerprint <- fingerprintCommand operation + pure (PlannedCommand operation fingerprint CommandWillRun) + -- | Count each command disposition without changing command order. summarizeCommandPlan :: CommandPlan -> CommandPlanSummary summarizeCommandPlan commandPlan = @@ -104,7 +129,7 @@ -- | 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) => + (Process :> es, IOE :> es) => UTCTime -> CommandPlan -> Eff es (Either CommandExecutionError [CommandReceipt]) @@ -117,7 +142,7 @@ -- stdout behavior; library callers that only need receipts use -- 'executeCommandPlan'. executeCommandPlanWithOutput :: - (Process :> es) => + (Process :> es, IOE :> es) => UTCTime -> (PlannedCommand -> Text -> Text -> Eff es ()) -> CommandPlan -> @@ -125,45 +150,91 @@ executeCommandPlanWithOutput completedAt onSuccess commandPlan = executeCommands completedAt onSuccess [] (commandPlan ^. #commands) +-- | Transient outcomes are never persisted as checkout completion history. +data CommandOutcomeStatus = CommandSucceeded | CommandFailed | CommandSkipped | CommandNotRun + deriving stock (Eq, Show, Generic) + +data CommandOutcome = CommandOutcome + { command :: !PlannedCommand, + status :: !CommandOutcomeStatus, + exitCode :: !(Maybe Int), + stdout :: !Text, + stderr :: !Text + } + deriving stock (Eq, Show, Generic) + +commandOutcomesFailed :: [CommandOutcome] -> Bool +commandOutcomesFailed = any ((== CommandFailed) . (^. #status)) + +-- | Check every component without following symlinks. Repeated immediately +-- before checkout invocations because a preceding shell may change the path. +checkCheckoutWorkDir :: FilePath -> Maybe FilePath -> IO (Either Text ()) +checkCheckoutWorkDir root workDir = do + let path = fromMaybe "." workDir + case if path == "." then Right () else validateCanonicalProjectPath (T.pack path) of + Left reason -> pure (Left reason) + Right () -> do + result <- try @IOException $ do + let parts = if path == "." then [] else Path.splitDirectories path + paths = scanl (Path.) root parts + safe <- + and + <$> forM + paths + ( \part -> do + link <- Directory.pathIsSymbolicLink part + directory <- Directory.doesDirectoryExist part + pure (not link && directory) + ) + pure $ if safe then Right () else Left ("checkout command workDir must be an existing real directory with real ancestors: " <> T.pack path) + pure $ either (Left . T.pack . displayException) id result + +-- | One shared shell executor. Capture the completed prefix and unrun tail, +-- including launch errors; callers choose receipt publication separately. +executeCommandOutcomes :: (Process :> es, IOE :> es) => CommandPlan -> Eff es [CommandOutcome] +executeCommandOutcomes commandPlan = go False (commandPlan ^. #commands) + where + go _ [] = pure [] + go failed (planned : remaining) + | failed = (emptyOutcome planned CommandNotRun :) <$> go True remaining + | planned ^. #disposition /= CommandWillRun = (emptyOutcome planned CommandSkipped :) <$> go False remaining + | otherwise = case planned ^. #operation of + operation@RunCommandOp {command, workDir} -> do + ready <- + if isCheckoutCommand operation + then liftIO (Directory.getCurrentDirectory >>= (\root -> checkCheckoutWorkDir root workDir)) + else pure (Right ()) + outcome <- case ready of + Left reason -> pure ((emptyOutcome planned CommandFailed) & #stderr .~ reason) + Right () -> do + launched <- E.try @IOException (runProcess "sh" ["-c", command] workDir) + pure $ case launched of + Left err -> (emptyOutcome planned CommandFailed) & #stderr .~ T.pack (displayException err) + Right (processExit, stdout, stderr) -> CommandOutcome planned (if processExit == ExitSuccess then CommandSucceeded else CommandFailed) (Just (case processExit of ExitSuccess -> 0; ExitFailure code -> code)) stdout stderr + (outcome :) <$> go (outcome ^. #status == CommandFailed) remaining + _ -> (emptyOutcome planned CommandSkipped :) <$> go False remaining + emptyOutcome command status = CommandOutcome command status Nothing "" "" + executeCommands :: - (Process :> es) => + (Process :> es, IOE :> es) => UTCTime -> (PlannedCommand -> Text -> Text -> Eff es ()) -> [CommandReceipt] -> [PlannedCommand] -> Eff es (Either CommandExecutionError [CommandReceipt]) -executeCommands completedAt onSuccess = go +executeCommands completedAt onSuccess completed commands = do + outcomes <- executeCommandOutcomes (CommandPlan commands) + forM_ outcomes $ \outcome -> when (outcome ^. #status == CommandSucceeded) (onSuccess (outcome ^. #command) (outcome ^. #stdout) (outcome ^. #stderr)) + pure $ case find ((== CommandFailed) . (^. #status)) outcomes of + Just failed -> Left (CommandExecutionError (failed ^. #command) (fromMaybe 127 (failed ^. #exitCode)) (failed ^. #stdout) (failed ^. #stderr)) + Nothing -> Right (reverse completed <> mapMaybe receipt outcomes) 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 + receipt outcome + | outcome ^. #status /= CommandSucceeded = Nothing + | isCheckoutCommand (outcome ^. #command . #operation) = Nothing + | otherwise = case outcome ^. #command . #operation of + RunCommandOp {moduleName, command, workDir} -> Just (CommandReceipt (outcome ^. #command . #fingerprint) moduleName command workDir completedAt) + _ -> Nothing -- | Produce the accepted receipt map for the plan's current declaration set. -- Removed commands are dropped. Fresh successes replace old receipts; @@ -178,13 +249,14 @@ 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 + receiptFor planned + | isCheckoutCommand (planned ^. #operation) = Nothing + | otherwise = 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 diff --git a/src/Seihou/CLI/Diff.hs b/src/Seihou/CLI/Diff.hs --- a/src/Seihou/CLI/Diff.hs +++ b/src/Seihou/CLI/Diff.hs @@ -5,6 +5,7 @@ where import Data.Generics.Labels () +import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Text.IO qualified as TIO import Seihou.CLI.Shared (logIO) @@ -29,7 +30,7 @@ Right Nothing -> pure (Right Nothing) Right (Just manifest) -> do tracked <- computeTrackedFileStatuses manifest - pure (Right (Just tracked)) + pure (Right (Just (tracked, Map.size (manifest ^. #seeds)))) colorEnabled <- useColor @@ -39,11 +40,17 @@ exitFailure Right Nothing -> TIO.putStrLn "No Seihou manifest found. Run 'seihou run ' to generate a project." - Right (Just tracked) -> - TIO.putStr (formatDiffOutput colorEnabled tracked) + Right (Just (tracked, seedCount)) -> + TIO.putStr (formatDiffOutput colorEnabled tracked seedCount) -formatDiffOutput :: Bool -> [TrackedFile] -> Text -formatDiffOutput color tracked = +formatDiffOutput :: Bool -> [TrackedFile] -> Int -> Text +formatDiffOutput color tracked seedCount = + formatted <> if seedCount == 0 then "" else T.pack (show seedCount) <> " seed files not compared\n" + where + formatted = formatTrackedDiff color tracked + +formatTrackedDiff :: Bool -> [TrackedFile] -> Text +formatTrackedDiff color tracked = let modified = filter (\t -> t ^. #status == TfsModified) tracked deleted = filter (\t -> t ^. #status == TfsDeleted) tracked unchanged = filter (\t -> t ^. #status == TfsUnchanged) tracked diff --git a/src/Seihou/CLI/ManifestCapabilityUpgrade.hs b/src/Seihou/CLI/ManifestCapabilityUpgrade.hs --- a/src/Seihou/CLI/ManifestCapabilityUpgrade.hs +++ b/src/Seihou/CLI/ManifestCapabilityUpgrade.hs @@ -26,6 +26,11 @@ -- closure rather than guessing. module Seihou.CLI.ManifestCapabilityUpgrade ( -- * Scope and evidence + SeedClaimEvidence, + resolveLegacySeedOwnership, + prepareSeedOwnership, + prepareRecordedSeedOwnership, + gatherSeedOwnershipEvidence, CertificationScope (..), EvidencePolicy (..), EvidenceSource (..), @@ -49,6 +54,8 @@ ) where +import Control.Monad (when) +import Data.Aeson qualified as Aeson import Data.Containers.ListUtils (nubOrd) import Data.Generics.Labels () import Data.List (find) @@ -59,16 +66,21 @@ import Seihou.CLI.ManifestGuard (ArtifactVerdict (..), judgeArtifact, machineLocalOriginNote) import Seihou.CLI.RecordedRelease (RecordedRelease (..), locateRecordedRelease, renderRecordedReleaseError) import Seihou.Composition.Instance (ModuleInstance (..)) -import Seihou.Composition.Plan (compileComposedPlan) +import Seihou.Composition.Plan (ComposedPlan (..), compileComposedPlan) import Seihou.Composition.Resolve (PromptPermission (..), resolveWithPromptPermission) import Seihou.Core.ArtifactIdentity (isMachineLocalOriginUrl) import Seihou.Core.ArtifactOriginDetect (detectArtifactOrigin) import Seihou.Core.ArtifactRef (resolveArtifactOrigin) +import Seihou.Core.Seed (renderManifestInvariantError, validateManifestInvariants) import Seihou.Core.Types import Seihou.Dhall.Eval (evalModuleFromFile) import Seihou.Effect.ConsoleInterp (runConsole) +import Seihou.Engine.Seed (seedOperationClaims) +import Seihou.Manifest.Types (manifestFromJSON, minimumManifestVersion) +import Seihou.Manifest.Upgrade (renderManifestUpgradeError, upgradeDocumentLosslessly) import Seihou.Prelude import System.Directory (doesPathExist) +import System.IO.Temp (withSystemTempDirectory) -- | Which unknown paths to certify. data CertificationScope @@ -229,6 +241,7 @@ operationDestination (WriteFileOp path _ _) = Just path operationDestination (CopyFileOp _ path) = Just path operationDestination (PatchFileOp path _ _ _ _) = Just path +operationDestination SeedFileOp {} = Nothing operationDestination CheckoutOutputOp {} = Nothing operationDestination CreateDirOp {} = Nothing operationDestination RunCommandOp {} = Nothing @@ -302,7 +315,7 @@ ] pure $ case compiled of Left errors -> EvidenceUnavailable ("it no longer compiles: " <> T.intercalate "; " errors) - Right (operations, _, _) -> EvidenceOperations operations sources + Right ComposedPlan {operations, seedOwners} -> EvidenceOperations (expandSeedEvidence seedOwners operations) sources loadInstance state = do installed <- loadInstalled state @@ -454,3 +467,68 @@ <> source ^. #originUrl <> " at " <> source ^. #revision + +-- | Exact recorded seed contributions, supplied by a compiler of recorded +-- releases, never by the candidate release. A failed lookup remains unknown. +type SeedClaimEvidence = Map ApplicationId (Either Text (Map FilePath (Set ModuleName))) + +-- | Resolve only receipts whose precise owners the operation needs. The caller +-- stages the result with its accepted transaction; this function never writes. +resolveLegacySeedOwnership :: Set FilePath -> Manifest -> SeedClaimEvidence -> Either Text Manifest +resolveLegacySeedOwnership paths manifest evidence = do + seeds <- Map.traverseWithKey resolve (manifest ^. #seeds) + let candidate = manifest & #seeds .~ seeds + first renderManifestInvariantError (validateManifestInvariants candidate) + pure candidate + where + resolve path receipt + | Set.notMember path paths = Right receipt + | otherwise = case receipt ^. #ownership of + KnownSeedOwners _ -> Right receipt + LegacySeedOwners apps -> do + when (Set.null apps) (Left (failure path "has no recorded application owners")) + owners <- Map.fromList <$> traverse (contribution path) (Set.toAscList apps) + pure (receipt & #ownership .~ KnownSeedOwners owners) + contribution path app = case Map.lookup app evidence of + Just (Right claims) | Just names <- Map.lookup path claims, not (Set.null names) -> Right (app, names) + Just (Left reason) -> Left (failure path (app ^. #unApplicationId <> ": " <> reason)) + _ -> Left (failure path (app ^. #unApplicationId <> " has no exact recorded seed contribution")) + failure path reason = + "cannot resolve seed ownership for '" + <> T.pack path + <> "': " + <> reason + <> "; restore access to the recorded module releases and retry the command" + +-- | The injectable evidence provider uses the same recorded-release policy as +-- 'gatherApplicationEvidence'. EP-3 supplies seed claims from its compiler. +prepareSeedOwnership :: Set FilePath -> Manifest -> (Set ApplicationId -> IO SeedClaimEvidence) -> IO (Either Text Manifest) +prepareSeedOwnership paths manifest gather = do + let wanted = Set.unions [apps | (path, receipt) <- Map.toAscList (manifest ^. #seeds), Set.member path paths, LegacySeedOwners apps <- [receipt ^. #ownership]] + evidence <- if Set.null wanted then pure Map.empty else gather wanted + pure (resolveLegacySeedOwnership paths manifest evidence) + +-- | Reuse the verified recorded-release loader. The extractor is supplied by +-- the seed compiler so ownership preparation does not depend on runtime effects. +gatherSeedOwnershipEvidence :: EvidencePolicy -> FilePath -> [FilePath] -> Manifest -> ([Operation] -> Map FilePath (Set ModuleName)) -> Set ApplicationId -> IO SeedClaimEvidence +gatherSeedOwnershipEvidence policy projectRoot searchPaths manifest extract wanted = do + recorded <- gatherApplicationEvidence policy projectRoot searchPaths manifest wanted + pure (Map.map (\case EvidenceUnavailable reason -> Left reason; EvidenceOperations operations _ -> Right (extract operations)) recorded) + +-- Each exact historical claimant must remain visible in evidence even when +-- composition chose one supplier for execution. Never use supplier provenance +-- as an owner index. +expandSeedEvidence :: Map FilePath (Set ModuleName) -> [Operation] -> [Operation] +expandSeedEvidence claims = concatMap $ \case + SeedFileOp {dest, content, strategy} -> [SeedFileOp dest content strategy name | name <- Set.toAscList (Map.findWithDefault Set.empty dest claims)] + op -> [op] + +prepareRecordedSeedOwnership :: FilePath -> [FilePath] -> Set FilePath -> Manifest -> IO (Either Text Manifest) +prepareRecordedSeedOwnership root searchPaths paths manifest + | Set.null paths = pure (Right manifest) + | otherwise = case first renderManifestUpgradeError (upgradeDocumentLosslessly (max (manifest ^. #version) (minimumManifestVersion SeedOwnerClaims)) (Aeson.toJSON manifest)) of + Left err -> pure (Left err) + Right (_, document) -> case first T.pack (manifestFromJSON (Aeson.encode document)) of + Left err -> pure (Left err) + Right prepared -> withSystemTempDirectory "seihou-seed-evidence" $ \session -> + prepareSeedOwnership paths prepared (gatherSeedOwnershipEvidence (FetchRecordedReleases session) root searchPaths prepared seedOperationClaims) diff --git a/src/Seihou/CLI/ManifestRepairOrigins.hs b/src/Seihou/CLI/ManifestRepairOrigins.hs --- a/src/Seihou/CLI/ManifestRepairOrigins.hs +++ b/src/Seihou/CLI/ManifestRepairOrigins.hs @@ -52,7 +52,7 @@ where import Control.Applicative ((<|>)) -import Control.Monad (when) +import Control.Monad (unless, when) import Data.Aeson qualified as Aeson import Data.Aeson.Types (parseMaybe, (.:)) import Data.ByteString.Lazy qualified as LBS @@ -75,7 +75,7 @@ Manifest, ManifestSchemaVersion (..), ) -import Seihou.Manifest.Types (currentManifestVersion, manifestFromJSON, manifestToJSON) +import Seihou.Manifest.Types (currentManifestVersion, manifestEncodingLoss, manifestFromJSON, manifestToJSON) import Seihou.Prelude import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, renamePath) import System.Exit (ExitCode (..), exitFailure) @@ -525,6 +525,8 @@ -- interrupted run never leaves a half-written manifest. writeManifestAtomically :: FilePath -> Manifest -> IO () writeManifestAtomically manifestPath manifest = do + unless (null (manifestEncodingLoss manifest)) $ + ioError (userError (T.unpack (T.intercalate "; " (manifestEncodingLoss manifest)))) let temporaryPath = manifestPath <> ".tmp" LBS.writeFile temporaryPath (manifestToJSON manifest) renamePath temporaryPath manifestPath diff --git a/src/Seihou/CLI/SchemaVersion.hs b/src/Seihou/CLI/SchemaVersion.hs --- a/src/Seihou/CLI/SchemaVersion.hs +++ b/src/Seihou/CLI/SchemaVersion.hs @@ -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/367b0a1390ac1ed3dda6e2cacfdf3e72b1f624df/package.dhall" +schemaUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/7d02695f5a716384ec2174a018c20ee680ab3d13/package.dhall" -- | SHA256 integrity hash for the schema import schemaHash :: Text -schemaHash = "sha256:ef20d62c240dfe0e1126e05534d58c467188af4198307ad3c2a4a713bcd93505" +schemaHash = "sha256:5a24b98eada6628e3e7da267f4e6c31c1e169179d2bacd5fed7254fc4cc55183" -- | Complete Dhall import line for use in generated modules schemaImportLine :: Text diff --git a/src/Seihou/CLI/StatusRender.hs b/src/Seihou/CLI/StatusRender.hs --- a/src/Seihou/CLI/StatusRender.hs +++ b/src/Seihou/CLI/StatusRender.hs @@ -2,6 +2,7 @@ ( formatStatus, formatStatusWith, formatCheckoutStatus, + seedSection, formatArtifactChecks, formatBlueprintMigrations, ModuleAdvice (..), @@ -101,6 +102,7 @@ ++ formatBlueprintMigrations (manifest ^. #blueprintMigrations) ++ appliedSection color manifest mEntries pendings ++ trackedSection color tracked + ++ seedSection manifest ++ varsSection manifest ++ updateSummarySection mEntries ++ recommendedActionsSection adviceList @@ -495,3 +497,9 @@ -- | Bounded checkout diagnostics, observed independently of artifact availability. formatCheckoutStatus :: CheckoutPlan -> Text formatCheckoutStatus = renderCheckoutStatus + +-- | Count committed settlements, never filesystem entries or live claims. +seedSection :: Manifest -> [Text] +seedSection manifest + | Map.null (manifest ^. #seeds) = [] + | otherwise = ["", "Seed files: " <> T.pack (show (Map.size (manifest ^. #seeds))) <> " (created once; owned by the project, not tracked)"] diff --git a/src/Seihou/CLI/Update.hs b/src/Seihou/CLI/Update.hs --- a/src/Seihou/CLI/Update.hs +++ b/src/Seihou/CLI/Update.hs @@ -29,7 +29,7 @@ import Data.Generics.Labels () import Data.List (find, isPrefixOf) import Data.Map.Strict qualified as Map -import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList) +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList) import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.IO qualified as TIO @@ -37,15 +37,7 @@ import Effectful (runEff) import Seihou.CLI.CommandExecution import Seihou.CLI.InstallShared (InstallOutcome (..), installModuleDir, summarizeInstallRefusal) -import Seihou.CLI.ManifestCapabilityUpgrade - ( CertificationGap (..), - CertificationScope (..), - EvidencePolicy (..), - EvidenceSource, - SharedWriteCertification, - certifiedChanges, - certifySharedWriteModesIO, - ) +import Seihou.CLI.ManifestCapabilityUpgrade (CertificationGap (..), CertificationScope (..), EvidencePolicy (..), EvidenceSource, SharedWriteCertification, certifiedChanges, certifySharedWriteModesIO, prepareRecordedSeedOwnership) import Seihou.CLI.Shared (deriveNamespace, toVarNameMap) import Seihou.CLI.Update.Migrations import Seihou.CLI.Update.Recovery @@ -53,7 +45,7 @@ import Seihou.CLI.Update.Source import Seihou.CLI.Update.Types import Seihou.Composition.Instance (ModuleInstance (..)) -import Seihou.Composition.Plan (compileComposedPlan) +import Seihou.Composition.Plan (ComposedPlan (..), compileComposedPlan) import Seihou.Composition.Recipe (expandRecipe) import Seihou.Composition.Resolve ( PromptPermission (..), @@ -61,11 +53,14 @@ loadComposition, resolveWithPromptPermission, ) -import Seihou.Core.Application (buildAppliedComposition, replaceAppliedComposition) +import Seihou.Core.Application (buildAppliedComposition, mkApplicationId, replaceAppliedComposition) +import Seihou.Core.ArtifactIdentity (sameArtifactIdentity) import Seihou.Core.ArtifactOriginDetect (detectArtifactOrigin) import Seihou.Core.ArtifactRef (renderArtifactRefError, resolveArtifactOrigin) import Seihou.Core.Checkout +import Seihou.Core.CommandFingerprint (checkoutCommandsFromOperations) import Seihou.Core.Module (defaultSearchPaths, discoverRunnable) +import Seihou.Core.Seed (seedApplicationIds) import Seihou.Core.Types import Seihou.Core.Version (parseVersion) import Seihou.Effect.BaselineStore (pruneBaselines) @@ -83,6 +78,7 @@ import Seihou.Engine.Checkout import Seihou.Engine.Migrate (ExecutedMigrationPlan (..), MigrationOpInstance (..), classifyMigration, executeMigration) import Seihou.Engine.Reconcile +import Seihou.Engine.Seed (seedOperationClaims) import Seihou.Engine.UpdateTransaction import Seihou.Manifest.Hash (hashContent) import Seihou.Manifest.JSON (decodeManifestValue) @@ -157,7 +153,20 @@ [ (Just previous, planned ^. #modulesInOrder) | (previous, planned) <- zip selected plannedApplications ] - stagedMigrations <- planAndStageMigrations projectRoot base catalog applicationInputs + let claims = applicationSeedClaims plannedApplications + selectedIdsForSeeds = Set.fromList (map (^. #candidate . #applicationId) plannedApplications) + neededLegacy = Set.fromList [path | (path, receipt) <- Map.toAscList (base ^. #seeds), LegacySeedOwners apps <- [receipt ^. #ownership], Map.member path claims || not (Set.null (apps `Set.intersection` selectedIdsForSeeds))] + relevant = not (Map.null claims) || any (\receipt -> not (Set.null (seedApplicationIds receipt `Set.intersection` selectedIdsForSeeds))) (Map.elems (base ^. #seeds)) + structurallyPrepared = if relevant then prepareManifestSchema manifestPath SeedOwnerClaims document base else Right base + paths <- defaultSearchPaths + preparedResult <- case structurallyPrepared of + Left err -> pure (Left err) + Right prepared -> fmap (first (UpdateCompositionFailed . pure)) (prepareRecordedSeedOwnership projectRoot paths neededLegacy prepared) + let preparedBase = either (const base) id preparedResult + protectedSeeds = Map.keysSet claims `Set.union` Map.keysSet (preparedBase ^. #seeds) + stagedMigrations <- case preparedResult of + Left err -> pure (Left err) + Right prepared -> planAndStageMigrationsWithSeeds projectRoot prepared catalog applicationInputs protectedSeeds case stagedMigrations of Left err -> pure (Left err) Right migrationStage -> do @@ -168,11 +177,11 @@ runEff $ runFilesystem $ runBaselineStore baselineDirectory $ - planReconciliation stageRoot (migrationStage ^. #manifest) selectedIds operations owners + planSeedReconciliation projectRoot stageRoot (migrationStage ^. #manifest) selectedIds operations owners claims case reconciliationResult of - Left err -> pure (Left (UpdateReconciliationFailed err)) + Left err -> pure (Left (reconciliationUpdateError preparedBase err)) Right reconciliation -> do - checkoutSetup <- planCheckoutUpdate projectRoot base plannedApplications + checkoutSetup <- planCheckoutUpdate projectRoot preparedBase plannedApplications case checkoutSetup of Left err -> pure (Left err) Right (checkoutCandidate, checkoutPlan, checkoutAdoptions) -> do @@ -191,7 +200,7 @@ <> versionWarnings <> map CheckoutWarning (concatMap (^. #warnings) (checkoutPlan ^. #entries)) inputChanges = summarizeInputChanges seedWarnings plannedApplications - transactionTargets = transactionTargetPaths base reconciliation (migrationStage ^. #plans) `Set.union` Map.keysSet checkoutAdoptions `Set.union` Set.fromList [entry ^. #dest | entry <- checkoutPlan ^. #entries, entry ^. #action `elem` [CreateLink, ReplaceLink, RetireLink]] + transactionTargets = transactionTargetPaths preparedBase reconciliation (migrationStage ^. #plans) `Set.union` Map.keysSet checkoutAdoptions `Set.union` Set.fromList [entry ^. #dest | entry <- checkoutPlan ^. #entries, entry ^. #action `elem` [CreateLink, ReplaceLink, RetireLink]] -- The manifest is observed as it is on disk, before -- any in-memory preparation, so an edit made between -- planning and apply is reported as a stale plan. @@ -228,7 +237,7 @@ request, snapshot, plannedApplications, - manifestPreparation = manifestPreparationFor manifest base (resolution ^. #evidenceSources) + manifestPreparation = manifestPreparationFor manifest preparedBase (resolution ^. #evidenceSources) } ) @@ -283,8 +292,13 @@ Left err -> pure (Left err) Right (MatchedAll applications) -> pure (Right (SelectionResolution manifest applications [] Nothing [])) Right (MatchedLegacy name) -> do - seeded <- seedLegacyApplication request projectRoot manifest now name - pure (fmap (\(applications, warnings) -> SelectionResolution manifest applications warnings Nothing []) seeded) + seeded <- seedLegacyApplication request sessionDirectory projectRoot installedDirectory manifest now name + case seeded of + Left err -> pure (Left err) + Right (applications, warnings, Nothing) -> pure (Right (SelectionResolution manifest applications warnings Nothing [])) + Right (applications, warnings, Just staged) -> do + included <- includeLegacyDependencies request projectRoot manifest now applications staged + pure (fmap (\(allApplications, next, additions) -> SelectionResolution manifest allApplications (warnings <> additions) (Just next) []) included) Right (MatchedNamed named) -> case prepareManifestSchema manifestPath TargetedAdditiveSharedPathUpdate document manifest of Left err -> pure (Left err) @@ -399,12 +413,12 @@ (upgradeDocumentLosslessly (minimumManifestVersion capability) document) case Aeson.fromJSON upgraded of Aeson.Error err -> Left (UpdateManifestUnreadable path (T.pack err)) - Aeson.Success prepared -> Right prepared + Aeson.Success prepared -> Right (prepared & #files .~ (manifest ^. #files)) -- | Describe what preparation changed, or 'Nothing' when it changed nothing. manifestPreparationFor :: Manifest -> Manifest -> [EvidenceSource] -> Maybe ManifestPreparation manifestPreparationFor original prepared evidenceSources - | original ^. #version == prepared ^. #version && Map.null modeChanges = Nothing + | original ^. #version == prepared ^. #version && original ^. #seeds == prepared ^. #seeds && Map.null modeChanges = Nothing | otherwise = Just ManifestPreparation @@ -451,7 +465,7 @@ applyAcceptedPlan :: UpdatePlan -> IO (Either UpdateError UpdateResult) applyAcceptedPlan plan = do - transactionResult <- beginUpdateTransaction (plan ^. #snapshot . #projectRoot) (plan ^. #snapshot . #transactionTargets) + transactionResult <- beginSeedUpdateTransaction (plan ^. #snapshot . #projectRoot) (plan ^. #snapshot . #transactionTargets) (Map.keysSet (Map.filter (\case FileSeedCreate {} -> True; _ -> False) (plan ^. #reconciliation . #files))) case transactionResult of Left err -> pure (Left (UpdateTransactionFailed err)) Right transaction -> do @@ -487,7 +501,7 @@ (reconciliationSummary resolvedActual) ) | otherwise -> do - let reconciliationManifest = (migratedManifest & #genAt .~ now) + let reconciliationManifest = migratedManifest & #genAt .~ now & #applications .~ foldl' (flip replaceAppliedComposition) (migratedManifest ^. #applications) (plan ^. #applications) appliedFiles <- applyReconciliation transaction resolvedActual reconciliationManifest case appliedFiles of Left err -> abortUpdate transaction (UpdateTransactionFailed err) @@ -495,7 +509,7 @@ linkResult <- applyUpdateCheckout plan migratedManifest filesManifest case linkResult of Left err -> abortUpdate transaction err - Right () -> do + Right checkoutWarnings -> do commandResult <- runEff $ runProcessIO $ @@ -518,7 +532,7 @@ written <- writeManifestIO (plan ^. #snapshot . #manifestPath) finalManifest case written of Left err -> abortUpdate transaction err - Right () -> finishCommitted transaction plan finalManifest completedReceipts + Right () -> finishCommitted transaction plan finalManifest checkoutWarnings planApplication :: UpdateRequest -> @@ -553,9 +567,11 @@ ] case compiled of Left errors -> pure (Left (UpdateCompositionFailed errors)) - Right (operations, compositionWarnings, rawOwners) -> do - targetOrigin <- publishedArtifactOrigin projectRoot targetArtifact - originedModules <- traverse (withInstanceOrigin projectRoot catalog) modulesInOrder + Right ComposedPlan {operations, warnings = compositionWarnings, managedOwners = rawOwners, seedOwners} -> do + proposedOrigin <- publishedArtifactOrigin projectRoot targetArtifact + let targetOrigin = if sameArtifactIdentity proposedOrigin (previous ^. #targetOrigin) then previous ^. #targetOrigin else proposedOrigin + proposedModules <- traverse (withInstanceOrigin projectRoot catalog) modulesInOrder + let originedModules = [(instanceId, modul, maybe origin (\state -> if sameArtifactIdentity origin (state ^. #origin) then state ^. #origin else origin) (find (\state -> state ^. #name == instanceId ^. #module_ && state ^. #parentVars == instanceId ^. #parentVars) (previous ^. #instances))) | (instanceId, modul, origin) <- proposedModules] let candidate0 = buildAppliedComposition (previous ^. #target) @@ -567,6 +583,8 @@ originedModules resolvedValues now + & #checkoutCommands + .~ checkoutCommandsFromOperations operations & #applicationId .~ (previous ^. #applicationId) candidate = @@ -586,13 +604,14 @@ candidate, modulesInOrder, resolvedValues, - operations, + operations = expandSeedClaims seedOwners operations, desiredOwners } ) where compositionWarning (FileOverwritten path old new) = CrossApplicationLastWriter path old new compositionWarning (ContentMerged path old new) = CrossApplicationLastWriter path old new + compositionWarning (SeedContentIgnored path old new) = CrossApplicationLastWriter path old new candidateRoot :: CandidateCatalog -> @@ -665,9 +684,42 @@ where configResult = first (UpdateConfigurationFailed . T.pack . show) -seedLegacyApplication :: +seedLegacyApplication :: UpdateRequest -> FilePath -> FilePath -> FilePath -> Manifest -> UTCTime -> Text -> IO (Either UpdateError ([AppliedComposition], [UpdateWarning], Maybe StagedSelection)) +seedLegacyApplication request session projectRoot installed manifest now requested = case roots of + [] -> fmap (fmap (\(apps, warnings) -> (apps, warnings, Nothing))) (seedInstalledLegacyApplication request projectRoot manifest now requested) + (target, origin, version) : _ -> do + let provisional = AppliedComposition (mkApplicationId target []) target origin version [] (Just (deriveNamespace (ModuleName requested))) Nothing [] Map.empty [] now + staged <- stageCandidateSources (session "legacy-candidate") projectRoot installed [provisional] + case staged of + Left err -> pure (Left err) + Right (catalog, sourceWarnings) -> case candidateRoot catalog provisional of + Left err -> pure (Left err) + Right (primary, additional, overrides, _) -> do + paths <- defaultSearchPaths + loaded <- loadComposition (catalog ^. #searchRoot : paths) primary additional + case loaded of + Left err -> pure (Left (CandidateLoadFailed requested err)) + Right modulesInOrder -> do + let (saved, legacyWarnings) = legacySavedValues manifest modulesInOrder + namespace = deriveNamespace primary + resolved <- resolveApplicationValues request namespace "" saved overrides modulesInOrder + case resolved of + Left err -> pure (Left err) + Right values -> do + origined <- traverse (withInstanceOrigin projectRoot catalog) modulesInOrder + let recorded = buildAppliedComposition target origin version additional (Just namespace) Nothing origined values now & #instances %~ map (restoreLegacyVersion manifest) + planned <- planApplication request projectRoot catalog now recorded + pure $ do + candidate <- planned + Right ([recorded], legacyWarnings, Just (StagedSelection (Set.singleton (recorded ^. #applicationId)) catalog sourceWarnings [candidate])) + where + roots = + [(AppliedModuleTarget (applied ^. #name), applied ^. #origin, applied ^. #moduleVersion) | applied <- manifest ^. #modules, applied ^. #name == ModuleName requested, applied ^. #parentVars == emptyParentVars] + <> [(AppliedRecipeTarget (recipe ^. #name), recipe ^. #origin, recipe ^. #recipeVersion) | recipe <- maybeToList (manifest ^. #recipe), recipe ^. #name == RecipeName requested] + +seedInstalledLegacyApplication :: UpdateRequest -> FilePath -> Manifest -> UTCTime -> Text -> IO (Either UpdateError ([AppliedComposition], [UpdateWarning])) -seedLegacyApplication request projectRoot manifest now requested = do +seedInstalledLegacyApplication request projectRoot manifest now requested = do searchPaths <- defaultSearchPaths discovered <- discoverRunnable searchPaths (ModuleName requested) case discovered of @@ -714,18 +766,22 @@ where declarations = [(instanceId, declaration) | (instanceId, modul, _) <- modulesInOrder, declaration <- modul ^. #vars] counts = Map.fromListWith (+) [(declaration ^. #name, 1 :: Int) | (_, declaration) <- declarations] + reusable name = Map.lookup name counts == Just 1 || (sharedExport name && sameTypes name && not (any (Map.member name . (^. #parentVars . #unParentVars) . (\(instanceId, _, _) -> instanceId)) modulesInOrder)) + sharedExport name = any (\(_, modul, _) -> any (\export -> export ^. #var == name && maybe True (== name) (export ^. #alias)) (modul ^. #exports)) modulesInOrder + sameTypes name = case [declaration ^. #type_ | (_, declaration) <- declarations, declaration ^. #name == name] of firstType : rest -> all (== firstType) rest; [] -> False saved = Map.fromListWith Map.union [ (instanceId, Map.singleton (declaration ^. #name) value) | (instanceId, declaration) <- declarations, - Map.lookup (declaration ^. #name) counts == Just 1, + reusable (declaration ^. #name), Just value <- [Map.lookup (declaration ^. #name) (manifest ^. #vars)] ] ambiguous = [ AmbiguousLegacyValue name | (name, count) <- Map.toAscList counts, count > 1, + not (reusable name), Map.member name (manifest ^. #vars) ] missing = @@ -739,7 +795,7 @@ restoreLegacyVersion :: Manifest -> AppliedInstanceState -> AppliedInstanceState restoreLegacyVersion manifest state = case find (\applied -> applied ^. #name == state ^. #name && applied ^. #parentVars == state ^. #parentVars) (manifest ^. #modules) of - Nothing -> state + Nothing -> state & #moduleVersion .~ Nothing Just applied -> AppliedInstanceState { name = state ^. #name, @@ -957,7 +1013,7 @@ transactionTargetPaths :: Manifest -> ReconciliationPlan -> [PlannedUpdateMigration] -> Set FilePath transactionTargetPaths manifest reconciliation migrations = - Map.keysSet (reconciliation ^. #files) `Set.union` Set.fromList (concatMap migrationTargets migrations) + reconciliationMutationPaths reconciliation `Set.union` Set.fromList (concatMap migrationTargets migrations) where migrationTargets migration = concatMap targets (migration ^. #stagedPlan . #ops) targets (MoveFileInst source destination _) = [source, destination] @@ -1019,8 +1075,8 @@ runEff $ runFilesystem $ runBaselineStore (plan ^. #snapshot . #baselineDirectory) $ - planReconciliation (plan ^. #snapshot . #projectRoot) manifest selected operations owners - pure (first UpdateReconciliationFailed result) + planSeedReconciliation (plan ^. #snapshot . #projectRoot) (plan ^. #snapshot . #projectRoot) manifest selected operations owners (applicationSeedClaims (plan ^. #plannedApplications)) + pure (first (reconciliationUpdateError manifest) result) -- | Reapply choices gathered after the initial read-only plan to the -- reconciliation rebuilt after real migration commands. Exact equality is @@ -1163,6 +1219,7 @@ context = composition ^. #context, instances, commandReceipts = receipts, + checkoutCommands = composition ^. #checkoutCommands, appliedAt = composition ^. #appliedAt } @@ -1273,9 +1330,9 @@ UpdateTransaction -> UpdatePlan -> Manifest -> - [CommandReceipt] -> + [UpdateWarning] -> IO (Either UpdateError UpdateResult) -finishCommitted transaction plan manifest completedReceipts = do +finishCommitted transaction plan manifest checkoutWarnings = do completion <- completeUpdateTransaction transaction pruneResult <- try @SomeException $ @@ -1312,13 +1369,13 @@ fileSummary = reconciliationSummary (plan ^. #reconciliation), commandSummary = CommandSummary - { executed = length completedReceipts, + { executed = summary ^. #willRun, skippedUnchanged = summary ^. #skippedUnchanged, skippedDisabled = summary ^. #skippedDisabled }, touchedPaths = touched, adoptedLinks = Map.keys (plan ^. #checkoutAdoptions), - warnings = plan ^. #warnings <> cleanupWarnings <> pruneWarnings + warnings = filter (\case CheckoutWarning _ -> False; _ -> True) (plan ^. #warnings) <> checkoutWarnings <> cleanupWarnings <> pruneWarnings } ) @@ -1369,56 +1426,6 @@ let summary = summarizeCommandPlan commandPlan in CommandSummary (summary ^. #willRun) (summary ^. #skippedUnchanged) (summary ^. #skippedDisabled) -isUpdateNoOp :: UpdatePlan -> Bool -isUpdateNoOp plan = - -- A lossless schema step or a newly certified shared-write mode is a - -- change to applied state that only this update will publish (ADR 0004), - -- so a plan carrying one is never a deliberate no-op (ADR 0007). - plan ^. #checkoutOutputs == plan ^. #snapshot . #originalManifest . #checkoutOutputs - && Map.null (plan ^. #checkoutAdoptions) - && all ((== UnchangedLink) . (^. #action)) (plan ^. #checkoutPlan . #entries) - && isNothing (plan ^. #manifestPreparation) - && 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 - -- A file whose content is unchanged can still carry a manifest record - -- that is out of date. The shared-write mode is the case that matters: a - -- project whose manifest predates the evidence has no answer for any path, and - -- treating that as a no-op would mean the answer is never written, so the - -- shared-path exemption could never take effect on an existing project. - -- Recording a fact about applied state is a change to applied state - -- (ADR 0004), so such a plan is not a deliberate no-op (ADR 0007). - unchangedFile (FileUnchanged desired _ _ prior) = - maybe True (\record -> record ^. #sharedWriteMode == recordedSharedWriteMode (plan ^. #reconciliation . #applicationIds) desired prior) prior - unchangedFile _ = False - -- Compare only what the manifest actually records. Anything derived from - -- where an artifact happens to sit on this machine would differ between a - -- decoded application and a freshly loaded candidate, and would report - -- every re-run as a change. - sameApplication previous candidate = - previous ^. #target == candidate ^. #target - && previous ^. #targetOrigin == candidate ^. #targetOrigin - && previous ^. #targetVersion == candidate ^. #targetVersion - && previous ^. #additionalModules == candidate ^. #additionalModules - && previous ^. #namespace == candidate ^. #namespace - && previous ^. #context == candidate ^. #context - && length (previous ^. #instances) == length (candidate ^. #instances) - && and (zipWith sameInstance (previous ^. #instances) (candidate ^. #instances)) - && previous ^. #commandReceipts == (candidate ^. #commandReceipts) - - sameInstance previous candidate = - previous ^. #name == candidate ^. #name - && previous ^. #parentVars == candidate ^. #parentVars - && previous ^. #origin == candidate ^. #origin - && previous ^. #moduleVersion == candidate ^. #moduleVersion - && previous ^. #resolvedVars == candidate ^. #resolvedVars - isStructuredNoOp :: UpdatePlan -> Bool isStructuredNoOp = isUpdateNoOp @@ -1468,7 +1475,7 @@ Just spec -> entry ^. #observation . #entry == EntrySymlink (expectedTarget (entry ^. #dest) spec) Nothing -> False -applyUpdateCheckout :: UpdatePlan -> Manifest -> Manifest -> IO (Either UpdateError ()) +applyUpdateCheckout :: UpdatePlan -> Manifest -> Manifest -> IO (Either UpdateError [UpdateWarning]) applyUpdateCheckout plan prior filesManifest = runEff $ runFilesystem $ runProcessIO $ do let candidate = filesManifest & #checkoutOutputs .~ plan ^. #checkoutOutputs & #applications .~ foldl' (flip replaceAppliedComposition) (filesManifest ^. #applications) (plan ^. #applications) root = plan ^. #snapshot . #projectRoot @@ -1479,4 +1486,51 @@ err : _ -> pure (Left (UpdateCheckoutFailed err)) [] -> do applied <- applyCheckoutPlan ApplyDeclaration root links - pure $ maybe (Right ()) (Left . UpdateCheckoutFailed) (applied ^. #failure) + pure $ maybe (Right (map CheckoutWarning (concatMap (^. #warnings) (links ^. #entries)))) (Left . UpdateCheckoutFailed) (applied ^. #failure) + +expandSeedClaims :: Map FilePath (Set ModuleName) -> [Operation] -> [Operation] +expandSeedClaims claims = concatMap $ \case + op@SeedFileOp {dest, content, strategy, moduleName} -> op : [SeedFileOp dest content strategy owner | owner <- Set.toAscList (Map.findWithDefault Set.empty dest claims), owner /= moduleName] + op -> [op] + +applicationSeedClaims :: [PlannedApplication] -> Map FilePath (Map ApplicationId (Set ModuleName)) +applicationSeedClaims = Map.unionsWith (Map.unionWith Set.union) . map claims + where + claims application = Map.map (Map.singleton (application ^. #candidate . #applicationId)) (seedOperationClaims (application ^. #operations)) + +-- Existing standalone dependency applications join legacy adoption's ordinary +-- preview. Declared edge bindings become saved inputs for that standalone root, +-- so both recorded applications describe the same shared producer output. +includeLegacyDependencies :: UpdateRequest -> FilePath -> Manifest -> UTCTime -> [AppliedComposition] -> StagedSelection -> IO (Either UpdateError ([AppliedComposition], StagedSelection, [UpdateWarning])) +includeLegacyDependencies request root manifest now legacy staged = do + let candidates = + [ (app, instanceId ^. #parentVars . #unParentVars) + | planned <- staged ^. #plannedApplications, + (instanceId, _, _) <- planned ^. #modulesInOrder, + instanceId ^. #module_ /= case planned ^. #candidate . #target of AppliedModuleTarget name -> name; _ -> ModuleName "", + app <- manifest ^. #applications, + app ^. #target == AppliedModuleTarget (instanceId ^. #module_), + Just artifact <- [Map.lookup (CandidateModule, instanceId ^. #module_ . #unModuleName) (staged ^. #catalog . #artifacts)], + Just url <- [artifact ^. #sourceUrl], + sameArtifactIdentity (app ^. #targetOrigin) (RemoteOrigin url (instanceId ^. #module_ . #unModuleName) (artifact ^. #repoName)) + ] + bindingSets = Map.fromListWith Set.union [(app ^. #applicationId, Set.singleton bindings) | (app, bindings) <- candidates] + unique = [(app, bindings) | app <- manifest ^. #applications, Just values <- [Map.lookup (app ^. #applicationId) bindingSets], bindings <- take 1 (Set.toList values)] + case [app | app <- manifest ^. #applications, maybe False ((> 1) . Set.size) (Map.lookup (app ^. #applicationId) bindingSets)] of + app : _ -> pure (Left (UpdateCompositionFailed ["dependency application '" <> targetName app <> "' is required with different input bindings; select compatible producer declarations before updating"])) + [] -> do + planned <- forM unique $ \(app, bindings) -> + planApplication (request & #varOverrides %~ (<> [(name ^. #unVarName, value) | (name, value) <- Map.toAscList bindings])) root (staged ^. #catalog) now app + pure $ do + added <- sequence planned + let previous = map fst unique <> legacy + allPlanned = added <> staged ^. #plannedApplications + Right + ( previous, + staged & #applicationIds .~ Set.fromList (map (^. #applicationId) previous) & #plannedApplications .~ allPlanned, + [DependencyApplicationIncluded (applicationRef manifest (app ^. #applicationId)) bindings | (app, bindings) <- unique] + ) + +reconciliationUpdateError :: Manifest -> ReconciliationError -> UpdateError +reconciliationUpdateError manifest (SeedReleaseBlockedByOwners path owners) = UpdateSeedReleaseBlocked path (Set.map (applicationRef manifest) owners) +reconciliationUpdateError _ err = UpdateReconciliationFailed err diff --git a/src/Seihou/CLI/Update/Interaction.hs b/src/Seihou/CLI/Update/Interaction.hs --- a/src/Seihou/CLI/Update/Interaction.hs +++ b/src/Seihou/CLI/Update/Interaction.hs @@ -34,7 +34,8 @@ deriving stock (Eq, Show) data InteractionError - = InteractionRequired (Set FilePath) + = SeedAdoptionRequiresInteraction (Set FilePath) + | InteractionRequired (Set FilePath) | InteractionAborted FilePath | InteractionResolutionFailed ReconciliationError | InteractionInputFailed Text @@ -63,6 +64,8 @@ where decisions = concatMap forceOne (Map.toAscList (plan ^. #reconciliation . #files)) forceOne (path, FileConflict _ _ _ reason _ _ Nothing) = case reason of + AdoptingSeedFile -> [] + AdoptingMissingSeedFile -> [] MergeDriverUnavailable _ -> [] _ -> [ResolveFile path AcceptGenerated] forceOne (path, FileOrphanEdited _ _ _ _ Nothing) = @@ -75,9 +78,11 @@ IO (Either InteractionError UpdatePlan) resolveInteractively mode plan | Set.null remaining = pure (Right plan) + | mode == NonInteractive && not (Set.null adoptions) = pure (Left (SeedAdoptionRequiresInteraction adoptions)) | mode == NonInteractive = pure (Left (InteractionRequired remaining)) | otherwise = go plan (Map.toAscList (plan ^. #reconciliation . #files)) where + adoptions = Map.keysSet (Map.filter (\case FileConflict _ _ _ reason _ _ Nothing -> reason `elem` [AdoptingSeedFile, AdoptingMissingSeedFile]; _ -> False) (plan ^. #reconciliation . #files)) remaining = unresolvedPaths (plan ^. #reconciliation) go current [] = pure (Right current) go current ((path, reconciliation) : rest) = case reconciliation of @@ -103,6 +108,13 @@ Text -> ReconciliationReason -> IO (Either InteractionError FileConflictChoice) +promptConflict path _ _ AdoptingMissingSeedFile = do + TIO.hPutStrLn stderr ("Adopt deleted project seed: " <> T.pack path) + promptChoice path "Choose [g]enerated (recreate and manage), [a]bort: " (\case "g" -> Just AcceptGenerated; "generated" -> Just AcceptGenerated; _ -> Nothing) +promptConflict path current _ AdoptingSeedFile = do + TIO.hPutStrLn stderr ("Adopt project seed: " <> T.pack path <> "; the producer proposes managed ownership") + TIO.hPutStrLn stderr (indentPreview current) + promptChoice path "Choose [g]enerated, [k]eep current and manage, [a]bort: " (\case "g" -> Just AcceptGenerated; "generated" -> Just AcceptGenerated; "k" -> Just KeepCurrent; "keep" -> Just KeepCurrent; _ -> Nothing) 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" diff --git a/src/Seihou/CLI/Update/Migrations.hs b/src/Seihou/CLI/Update/Migrations.hs --- a/src/Seihou/CLI/Update/Migrations.hs +++ b/src/Seihou/CLI/Update/Migrations.hs @@ -1,6 +1,7 @@ module Seihou.CLI.Update.Migrations ( StagedMigrations (..), planAndStageMigrations, + planAndStageMigrationsWithSeeds, migrationTouchedPaths, migrationTouchesDirectories, ) @@ -26,6 +27,7 @@ MigrationOpInstance (..), classifyMigration, executeMigration, + validateSeedMigration, ) import Seihou.Prelude import System.Directory qualified as Directory @@ -59,11 +61,15 @@ CandidateCatalog -> [(Maybe AppliedComposition, [(ModuleInstance, Module, FilePath)])] -> IO (Either UpdateError StagedMigrations) -planAndStageMigrations projectRoot manifest catalog applications = do - initialFilesystem <- snapshotTrackedFiles projectRoot manifest +planAndStageMigrations root manifest catalog applications = planAndStageMigrationsWithSeeds root manifest catalog applications (Map.keysSet (manifest ^. #seeds)) + +planAndStageMigrationsWithSeeds :: FilePath -> Manifest -> CandidateCatalog -> [(Maybe AppliedComposition, [(ModuleInstance, Module, FilePath)])] -> Set FilePath -> IO (Either UpdateError StagedMigrations) +planAndStageMigrationsWithSeeds projectRoot manifest catalog applications protected = do + initialFilesystem <- snapshotTrackedFiles projectRoot (manifest & #files %~ (`Map.withoutKeys` protected)) pure $ do transitions <- collectTransitions catalog applications planned <- traverse planTransition (deduplicateTransitions transitions) + mapM_ (\(transition, sourcePlan) -> first (UpdateMigrationStageFailed (transition ^. #moduleName)) (validateSeedMigration protected (concatMap (^. #ops) (sourcePlan ^. #steps)))) planned let processMocks = concatMap commandMocks planned ((stageResult, finalFilesystem)) = runPureEff $ diff --git a/src/Seihou/CLI/Update/Render.hs b/src/Seihou/CLI/Update/Render.hs --- a/src/Seihou/CLI/Update/Render.hs +++ b/src/Seihou/CLI/Update/Render.hs @@ -35,6 +35,7 @@ import Seihou.CLI.Update.Types import Seihou.Core.ArtifactRef (renderArtifactRefError) import Seihou.Core.Checkout (CheckoutAction (..), CheckoutEntry (..), CheckoutError (..), CheckoutPlan (..)) +import Seihou.Core.CommandFingerprint (isCheckoutCommand) import Seihou.Core.Migration (MigrationPlan (..), MigrationPlanError (..)) import Seihou.Core.Types ( ApplicationId (..), @@ -71,12 +72,13 @@ ReconciliationPlan (..), ReconciliationSummary (..), ResolvedFileConflict (..), + SeedAction (..), reconciliationSummary, recordedSharedWriteMode, ) import Seihou.Engine.Reconcile qualified as Reconcile import Seihou.Engine.UpdateTransaction (TransactionError (..)) -import Seihou.Manifest.Types (sharedWriteModeToText) +import Seihou.Manifest.Types (currentManifestVersion, sharedWriteModeToText) import Seihou.Prelude newtype UpdatePlanView = UpdatePlanView UpdatePlan @@ -117,13 +119,16 @@ renderUpdateHuman :: Bool -> UpdateOutput -> Text renderUpdateHuman _ (UpdatePlanOutput (UpdatePlanView plan)) = T.unlines $ - preparationLines (plan ^. #manifestPreparation) + seedLines (plan ^. #reconciliation) + <> preparationLines (displayedPreparation plan) <> versionLines plan <> [ renderInputs (plan ^. #inputChanges), "Migrations: " <> count (length (plan ^. #migrations)) <> migrationCaveat plan, renderFiles (reconciliationSummary (plan ^. #reconciliation)), - renderCommands (summarizeCommandPlan (plan ^. #commandPlan)) + if isUpdateNoOp plan then "Commands: 0 will run (no project update)" else renderCommands (summarizeCommandPlan (plan ^. #commandPlan)) ] + <> ["Checkout declarations changed: " <> application ^. #candidate . #applicationId . #unApplicationId | application <- plan ^. #plannedApplications, maybe [] (^. #checkoutCommands) (application ^. #previous) /= application ^. #candidate . #checkoutCommands] + <> [" checkout " <> (if isUpdateNoOp plan then "not-run-no-update" else dispositionText (command ^. #disposition)) <> ": " <> fromMaybe "" (commandText (command ^. #operation)) | command <- plan ^. #commandPlan . #commands, isCheckoutCommand (command ^. #operation)] <> T.lines (renderCheckoutPlan True (plan ^. #checkoutPlan)) <> ["Adopt link: " <> T.pack path <> " (stop tracking in Git; keep working link)" | path <- Map.keys (plan ^. #checkoutAdoptions)] <> conflictLines (plan ^. #reconciliation) @@ -153,16 +158,16 @@ object [ "schemaVersion" .= (1 :: Int), "outcome" .= ("plan" :: Text), - "alreadyUpToDate" .= planLooksUnchanged plan, - "manifestPreparation" .= fmap preparationValue (plan ^. #manifestPreparation), + "alreadyUpToDate" .= isUpdateNoOp plan, + "manifestPreparation" .= fmap preparationValue (displayedPreparation plan), "applications" .= map applicationIdText (plan ^. #applications), "versions" .= map versionValue (plan ^. #versionChanges), "inputs" .= inputValue (plan ^. #inputChanges), "migrations" .= map migrationValue (plan ^. #migrations), - "checkout" .= checkoutReportJSON (CheckoutSyncResult (plan ^. #snapshot . #projectRoot) True (plan ^. #checkoutPlan) (CheckoutExecution Map.empty [] Nothing) []), + "checkout" .= checkoutReportJSON (CheckoutSyncResult (plan ^. #snapshot . #projectRoot) True (plan ^. #checkoutPlan) (CheckoutExecution Map.empty [] Nothing) [] [] []), "checkoutAdoptions" .= Map.keys (plan ^. #checkoutAdoptions), "files" .= map fileValue (Map.toAscList (plan ^. #reconciliation . #files)), - "commands" .= map commandValue (plan ^. #commandPlan . #commands), + "commands" .= map (commandValue (isUpdateNoOp plan)) (plan ^. #commandPlan . #commands), "warnings" .= map warningText (plan ^. #warnings) ] outputValue (UpdateAppliedOutput (UpdateResultView result)) = @@ -190,6 +195,17 @@ ] -- | The manifest change a targeted update stages before it plans. +-- Checkout adoption publishes the current schema, even when the preliminary +-- ownership check needed only an earlier schema. Show the resulting version. +displayedPreparation :: UpdatePlan -> Maybe ManifestPreparation +displayedPreparation plan + | Map.null (plan ^. #checkoutOutputs) = plan ^. #manifestPreparation + | original ^. #version == currentManifestVersion = plan ^. #manifestPreparation + | otherwise = Just (preparation & #toVersion .~ currentManifestVersion) + where + original = plan ^. #snapshot . #originalManifest + preparation = fromMaybe (ManifestPreparation (original ^. #version) currentManifestVersion Map.empty [] original) (plan ^. #manifestPreparation) + preparationLines :: Maybe ManifestPreparation -> [Text] preparationLines Nothing = [] preparationLines (Just preparation) = @@ -318,7 +334,13 @@ renderOne _ = [] warningLines :: [UpdateWarning] -> [Text] -warningLines = map (("Warning: " <>) . warningText) +warningLines = map $ \warning -> + let label = case warning of + DependencyApplicationIncluded {} -> "Dependency: " + CrossApplicationLastWriter {} -> "Ownership: " + MissingLegacyValue {} -> "Inputs: " + _ -> "Warning: " + in label <> warningText warning versionValue :: VersionChange -> Value versionValue change = @@ -358,6 +380,10 @@ ] classification :: FileReconciliation -> Text +classification FileSeedCreate {} = "seedCreate" +classification FileSeedSettle {} = "seedSettle" +classification FileSeedRelease {} = "seedRelease" +classification FileSeedAbandon {} = "seedAbandon" classification FileCreate {} = "create" classification FileUpdate {} = "update" classification FileAutoMerge {} = "autoMerge" @@ -373,13 +399,14 @@ resolutionFor (FileOrphanEdited _ _ _ _ choice) = orphanChoiceText <$> choice resolutionFor _ = Nothing -commandValue :: PlannedCommand -> Value -commandValue planned = +commandValue :: Bool -> PlannedCommand -> Value +commandValue noUpdate planned = object [ "fingerprint" .= fingerprintText (planned ^. #fingerprint), - "status" .= dispositionText (planned ^. #disposition), + "status" .= (if noUpdate && planned ^. #disposition == CommandWillRun then "not-run-no-update" else dispositionText (planned ^. #disposition)), "module" .= commandModule (planned ^. #operation), - "command" .= commandText (planned ^. #operation) + "command" .= commandText (planned ^. #operation), + "lifecycle" .= (if isCheckoutCommand (planned ^. #operation) then "checkout" else "application" :: Text) ] commandModule :: Operation -> Maybe Text @@ -435,6 +462,11 @@ -- exhaustive, with no fallback to 'show': a new constructor must not compile -- its way into the terminal as Haskell syntax. warningText :: UpdateWarning -> Text +warningText (DependencyApplicationIncluded application bindings) = + "include " + <> applicationLabel application + <> " from the selected application's dependency graph" + <> if Map.null bindings then "" else "; declared bindings: " <> T.intercalate ", " [name ^. #unVarName <> "=" <> value | (name, value) <- Map.toAscList bindings] warningText (LocalArtifactHasNoRemote name) = name <> " has no recorded remote, so the locally installed copy is the update candidate;" @@ -502,6 +534,7 @@ errorCode UpdateMigrationStageFailed {} = "migration_stage_failed" errorCode (UpdateCheckoutFailed err) = err ^. #code errorCode UpdateCompositionFailed {} = "composition_failed" +errorCode UpdateSeedReleaseBlocked {} = "seed_release_blocked_by_owners" errorCode UpdateReconciliationFailed {} = "reconciliation_failed" errorCode UpdateHasUnresolvedPaths {} = "unresolved_paths" errorCode UpdateRecoveryFailed {} = "recovery_failed" @@ -603,6 +636,8 @@ errorMessage (UpdateCheckoutFailed err) = err ^. #message errorMessage (UpdateCompositionFailed problems) = "The candidate composition is invalid: " <> T.intercalate "; " problems +errorMessage (UpdateSeedReleaseBlocked path owners) = + "Cannot release '" <> T.pack path <> "' while these managed application owners remain outside the selection: " <> T.intercalate ", " (map applicationLabel (Set.toAscList owners)) <> ". Review 'seihou update --dry-run' to include all recorded applications together; every candidate owner must declare seed ownership." errorMessage (UpdateReconciliationFailed err) = reconciliationErrorText err errorMessage (UpdateHasUnresolvedPaths paths) = @@ -679,7 +714,20 @@ migrationExecErrorText (MigrationUnsafePath label path reason) = "unsafe migration " <> label <> " '" <> T.pack path <> "': " <> reason +seedLines :: ReconciliationPlan -> [Text] +seedLines plan = ["Seed: " <> label item <> " " <> T.pack path | (path, item) <- Map.toAscList (plan ^. #files), case item of FileSeedCreate {} -> True; FileSeedSettle {} -> True; FileSeedRelease {} -> True; FileSeedAbandon {} -> True; _ -> False] + where + label FileSeedCreate {} = "create once" + label FileSeedSettle {} = "keep project file" + label FileSeedRelease {} = "release to project" + label FileSeedAbandon {} = "retire claim; keep project file" + label _ = "" + reconciliationErrorText :: ReconciliationError -> Text +reconciliationErrorText (Reconcile.SeedReconciliationFailed reason) = reason +reconciliationErrorText (Reconcile.SeedReleaseBlockedByOwners path owners) = "cannot release '" <> T.pack path <> "' while unselected managed application owners remain: " <> T.intercalate ", " (map (^. #unApplicationId) (Set.toAscList owners)) <> "; review seihou update --dry-run to include all recorded applications" +reconciliationErrorText (Reconcile.SeedPathAlsoManaged path) = "seed path '" <> T.pack path <> "' also has a managed or overlapping claim; publish compatible producer declarations" +reconciliationErrorText (Reconcile.InvalidSeedAdoptionChoice path) = "adopting seed '" <> T.pack path <> "' requires an explicit supported keep or accept choice; a missing seed can only be accepted for recreation or the update aborted" reconciliationErrorText (InvalidReconciliationPath path reason) = "Path " <> T.pack path <> " cannot be reconciled: " <> reason reconciliationErrorText (MissingDesiredOwner path) = @@ -734,28 +782,6 @@ <> " updated, " <> count (summary ^. #safeDeletes) <> " deleted" - -planLooksUnchanged :: UpdatePlan -> Bool -planLooksUnchanged plan = - plan ^. #checkoutOutputs == plan ^. #snapshot . #originalManifest . #checkoutOutputs - && Map.null (plan ^. #checkoutAdoptions) - && all ((== UnchangedLink) . (^. #action)) (plan ^. #checkoutPlan . #entries) - && isNothing (plan ^. #manifestPreparation) - && 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 - -- Kept in step with 'Seihou.CLI.Update.isUpdateNoOp': a file whose bytes - -- are unchanged still counts as a change when this plan would record a - -- different shared-write mode than the manifest holds, so @alreadyUpToDate@ - -- does not claim otherwise. - isUnchanged (FileUnchanged desired _ _ prior) = - maybe True (\record -> record ^. #sharedWriteMode == recordedSharedWriteMode (plan ^. #reconciliation . #applicationIds) desired prior) prior - isUnchanged _ = False count :: Int -> Text count = T.pack . show diff --git a/src/Seihou/CLI/Update/Selection.hs b/src/Seihou/CLI/Update/Selection.hs --- a/src/Seihou/CLI/Update/Selection.hs +++ b/src/Seihou/CLI/Update/Selection.hs @@ -17,6 +17,7 @@ import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Seihou.CLI.Update.Types +import Seihou.Core.ArtifactIdentity (sameArtifactIdentity) import Seihou.Core.Types import Seihou.Prelude @@ -73,8 +74,24 @@ | null (manifest ^. #applications) -> case nubOrd names of [name] -> Right (MatchedLegacy name) _ -> Left LegacyUpdateRequiresOneTarget - | otherwise -> MatchedNamed <$> foldM selectName Set.empty (nubOrd names) + | [name] <- nubOrd names, not (any (\app -> targetName app == name || containsModule name app) (manifest ^. #applications)), any ((== name) . (^. #name . #unModuleName)) (manifest ^. #modules) -> Right (MatchedLegacy name) + | otherwise -> MatchedNamed . expandDependencies <$> foldM selectName Set.empty (nubOrd names) where + expandDependencies selected = + let required = + Set.fromList + [ other ^. #applicationId + | app <- manifest ^. #applications, + Set.member (app ^. #applicationId) selected, + state <- app ^. #instances, + AppliedModuleTarget root <- [app ^. #target], + state ^. #name /= root, + other <- manifest ^. #applications, + other ^. #target == AppliedModuleTarget (state ^. #name), + sameArtifactIdentity (state ^. #origin) (other ^. #targetOrigin) + ] + next = selected `Set.union` required + in if next == selected then selected else expandDependencies next selectName selected name = let exact = filter ((== name) . targetName) (manifest ^. #applications) matches = @@ -206,7 +223,7 @@ AppliedRecipeTarget name -> (name ^. #unRecipeName) availableTargets :: Manifest -> [Text] -availableTargets manifest = nubOrd (map targetName (manifest ^. #applications) <> instanceNames) +availableTargets manifest = nubOrd (map targetName (manifest ^. #applications) <> instanceNames <> map (^. #name . #unModuleName) (manifest ^. #modules)) where instanceNames = [ state ^. #name . #unModuleName diff --git a/src/Seihou/CLI/Update/Source.hs b/src/Seihou/CLI/Update/Source.hs --- a/src/Seihou/CLI/Update/Source.hs +++ b/src/Seihou/CLI/Update/Source.hs @@ -18,6 +18,7 @@ copyDirectoryRecursive, ) import Seihou.CLI.Update.Types +import Seihou.Core.ArtifactIdentity (normalizeOriginUrl) import Seihou.Core.ArtifactRef (ArtifactRefError, resolveArtifactOrigin) import Seihou.Core.Module (defaultSearchPaths, validateModule) import Seihou.Core.Recipe (validateRecipe) @@ -58,7 +59,7 @@ requirements <- requirementsFor projectRoot installedDirectory selected let remoteOrigins = Map.fromList - [ (origin ^. #sourceUrl, origin) + [ (normalizeOriginUrl (origin ^. #sourceUrl), origin) | requirement <- requirements, Just origin <- [requirement ^. #origin] ] @@ -66,7 +67,7 @@ searchRoot = sessionRoot "search" Directory.createDirectoryIfMissing True clonesRoot Directory.createDirectoryIfMissing True searchRoot - remoteResult <- stageRemoteOrigins clonesRoot searchRoot (Map.toAscList remoteOrigins) + remoteResult <- stageRemoteOrigins clonesRoot searchRoot [(origin ^. #sourceUrl, origin) | origin <- Map.elems remoteOrigins] case remoteResult of Left err -> pure (Left err) Right (remoteArtifacts, clones) -> do @@ -358,7 +359,7 @@ Just candidate -> case requirement ^. #origin of Nothing -> Right () Just origin - | candidate ^. #sourceUrl == Just (origin ^. #sourceUrl) -> Right () + | fmap normalizeOriginUrl (candidate ^. #sourceUrl) == Just (normalizeOriginUrl (origin ^. #sourceUrl)) -> Right () | otherwise -> Left (CandidateArtifactMissing (requirement ^. #kind) (requirement ^. #name)) gitRevision :: FilePath -> IO (Maybe Text) diff --git a/src/Seihou/CLI/Update/Types.hs b/src/Seihou/CLI/Update/Types.hs --- a/src/Seihou/CLI/Update/Types.hs +++ b/src/Seihou/CLI/Update/Types.hs @@ -17,28 +17,39 @@ CommandSummary (..), UpdateResult (..), UpdateError (..), + isUpdateNoOp, ) where +import Data.Generics.Labels () import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (isNothing, mapMaybe) import Data.Set (Set) import Seihou.CLI.CommandExecution - ( CommandExecutionError, - CommandPlan, - CommandPolicy, + ( CommandDisposition (..), + CommandExecutionError, + CommandPlan (..), + CommandPolicy (..), + PlannedCommand (..), ) import Seihou.CLI.ManifestCapabilityUpgrade (CertificationGap, EvidenceSource) import Seihou.Composition.Instance (ModuleInstance) import Seihou.Core.ArtifactRef (ArtifactRefError) -import Seihou.Core.Checkout (CheckoutError, CheckoutPlan) +import Seihou.Core.Checkout (CheckoutAction (..), CheckoutEntry (..), CheckoutError, CheckoutPlan (..)) +import Seihou.Core.CommandFingerprint (isCheckoutCommand) import Seihou.Core.Migration (MigrationPlan, MigrationPlanError) +import Seihou.Core.Seed (replaceSelectedSeedClaims) import Seihou.Core.Types import Seihou.Engine.Migrate (ExecutedMigrationPlan, MigrationExecError) import Seihou.Engine.Reconcile ( DesiredFileOwner, + FileReconciliation (..), ReconciliationError, - ReconciliationPlan, + ReconciliationPlan (..), ReconciliationSummary, + recordedSharedWriteMode, + seedCandidateReceipts, ) import Seihou.Engine.UpdateTransaction (TransactionError) import Seihou.Prelude @@ -188,7 +199,8 @@ deriving stock (Eq, Generic, Show) data UpdateWarning - = LocalArtifactHasNoRemote Text + = DependencyApplicationIncluded ApplicationRef (Map VarName Text) + | LocalArtifactHasNoRemote Text | SameVersionContentChanged Text | AmbiguousLegacyValue VarName | MissingLegacyValue VarName @@ -276,6 +288,7 @@ | UpdateMigrationStageFailed ModuleName MigrationExecError | UpdateCompositionFailed [Text] | UpdateCheckoutFailed CheckoutError + | UpdateSeedReleaseBlocked FilePath (Set ApplicationRef) | UpdateReconciliationFailed ReconciliationError | UpdateHasUnresolvedPaths (Set FilePath) | UpdateRecoveryFailed [TransactionError] @@ -287,3 +300,64 @@ | UpdateCachePublicationFailed Text | UpdateManifestWriteFailed Text deriving stock (Eq, Show) + +isUpdateNoOp :: UpdatePlan -> Bool +isUpdateNoOp plan = + -- A lossless schema step or a newly certified shared-write mode is a + -- change to applied state that only this update will publish (ADR 0004), + -- so a plan carrying one is never a deliberate no-op (ADR 0007). + plan ^. #checkoutOutputs == plan ^. #snapshot . #originalManifest . #checkoutOutputs + && Map.null (plan ^. #checkoutAdoptions) + && all ((== UnchangedLink) . (^. #action)) (plan ^. #checkoutPlan . #entries) + && isNothing (plan ^. #manifestPreparation) + && null (plan ^. #versionChanges) + && null (plan ^. #migrations) + && plan ^. #inputChanges . #overridden == 0 + && plan ^. #inputChanges . #newlyResolved == 0 + && plan ^. #inputChanges . #removed == 0 + && not (any actionableCommand (plan ^. #commandPlan . #commands)) + && seedClaimsUnchanged + && all unchangedFile (Map.elems (plan ^. #reconciliation . #files)) + && and (zipWith sameApplication (mapMaybe (^. #previous) (plan ^. #plannedApplications)) (plan ^. #applications)) + where + actionableCommand command = command ^. #disposition == CommandWillRun && (plan ^. #request . #commandPolicy == RunAllCommands || not (isCheckoutCommand (command ^. #operation))) + -- A file whose content is unchanged can still carry a manifest record + -- that is out of date. The shared-write mode is the case that matters: a + -- project whose manifest predates the evidence has no answer for any path, and + -- treating that as a no-op would mean the answer is never written, so the + -- shared-path exemption could never take effect on an existing project. + -- Recording a fact about applied state is a change to applied state + -- (ADR 0004), so such a plan is not a deliberate no-op (ADR 0007). + seedClaimsUnchanged = + let original = plan ^. #snapshot . #originalManifest + reconciliation = plan ^. #reconciliation + candidate = seedCandidateReceipts (original ^. #genAt) original reconciliation + in case replaceSelectedSeedClaims (reconciliation ^. #applicationIds) candidate original of + Right next -> next ^. #seeds == original ^. #seeds + Left _ -> False + unchangedFile FileSeedSettle {} = True + unchangedFile (FileUnchanged desired _ _ prior) = + maybe True (\record -> record ^. #sharedWriteMode == recordedSharedWriteMode (plan ^. #reconciliation . #applicationIds) desired prior) prior + unchangedFile _ = False + -- Compare only what the manifest actually records. Anything derived from + -- where an artifact happens to sit on this machine would differ between a + -- decoded application and a freshly loaded candidate, and would report + -- every re-run as a change. + sameApplication previous candidate = + previous ^. #target == candidate ^. #target + && previous ^. #targetOrigin == candidate ^. #targetOrigin + && previous ^. #targetVersion == candidate ^. #targetVersion + && previous ^. #additionalModules == candidate ^. #additionalModules + && previous ^. #namespace == candidate ^. #namespace + && previous ^. #context == candidate ^. #context + && length (previous ^. #instances) == length (candidate ^. #instances) + && and (zipWith sameInstance (previous ^. #instances) (candidate ^. #instances)) + && previous ^. #commandReceipts == (candidate ^. #commandReceipts) + && previous ^. #checkoutCommands == candidate ^. #checkoutCommands + + sameInstance previous candidate = + previous ^. #name == candidate ^. #name + && previous ^. #parentVars == candidate ^. #parentVars + && previous ^. #origin == candidate ^. #origin + && previous ^. #moduleVersion == candidate ^. #moduleVersion + && previous ^. #resolvedVars == candidate ^. #resolvedVars diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -40,6 +40,8 @@ import Seihou.CLI.RepairOriginsE2ESpec qualified as RepairOriginsE2ESpec import Seihou.CLI.RunBlueprintRefusalSpec qualified as RunBlueprintRefusalSpec import Seihou.CLI.SavePromptedSpec qualified as SavePromptedSpec +import Seihou.CLI.SeedRunE2ESpec qualified as SeedRunE2E +import Seihou.CLI.SeedUpdateE2ESpec qualified as SeedUpdateE2E import Seihou.CLI.SharedManifestE2ESpec qualified as SharedManifestE2ESpec import Seihou.CLI.StatusSpec qualified as StatusSpec import Seihou.CLI.UpdateE2ESpec qualified as UpdateE2ESpec @@ -105,4 +107,6 @@ AgentUpgradeE2ESpec.tests, FzfSpec.tests ] - defaultMain (testGroup "seihou-cli" tests) + seedUpdateTests <- SeedUpdateE2E.tests + seedRunTests <- SeedRunE2E.tests + defaultMain (testGroup "seihou-cli" (seedUpdateTests : seedRunTests : tests)) diff --git a/test/Seihou/CLI/CheckoutSyncE2ESpec.hs b/test/Seihou/CLI/CheckoutSyncE2ESpec.hs --- a/test/Seihou/CLI/CheckoutSyncE2ESpec.hs +++ b/test/Seihou/CLI/CheckoutSyncE2ESpec.hs @@ -1,15 +1,18 @@ -module Seihou.CLI.CheckoutSyncE2ESpec (tests) where +module Seihou.CLI.CheckoutSyncE2ESpec (tests, copyPinnedSchema) where -import Control.Monad (forM_, unless) +import Control.Monad (forM_, unless, when) import Data.Aeson qualified as A import Data.Aeson.KeyMap qualified as KM import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.List (isInfixOf) +import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.Encoding qualified as TE import Data.Text.IO qualified as TIO +import Seihou.CLI.SchemaVersion (schemaUrl) import Seihou.CLI.SeihouBinary (seihouBinary) +import Seihou.Engine.UpdateTransaction (beginUpdateTransaction) import System.Directory qualified as D import System.Environment (getEnvironment) import System.Exit (ExitCode (..)) @@ -20,6 +23,24 @@ import Test.Tasty import Test.Tasty.Hspec (testSpec) +-- Use the published pin from Git objects in a checkout, or the explicitly +-- identified schema staged by the package builder. Imports remain offline. +copyPinnedSchema source destination = do + let revision = T.unpack (last (init (T.splitOn "/" schemaUrl))) + marker = source ".seihou-pinned-revision" + packaged <- D.doesFileExist marker + if packaged + then do + actual <- T.strip <$> TIO.readFile marker + unless (actual == T.pack revision) (fail "packaged schema does not match the executable's published pin") + files <- D.listDirectory source + forM_ (filter ((== ".dhall") . takeExtension) files) $ \file -> D.copyFile (source file) (destination file) + else do + files <- lines <$> readProcess "git" ["-C", source, "ls-tree", "--name-only", revision] "" + forM_ (filter ((== ".dhall") . takeExtension) files) $ \file -> do + content <- readProcess "git" ["-C", source, "show", revision <> ":" <> file] "" + TIO.writeFile (destination file) (T.pack content) + -- Every invocation has an empty personal configuration/cache and no inherited HOME. invoke binary root home args = do inherited <- getEnvironment @@ -57,7 +78,7 @@ "vars = [S.VarDecl::{name = \"source\", type = \"text\", default = Some \"" <> source <> "\"}, S.VarDecl::{name = \"enabled\", type = \"bool\", default = Some \"" <> enabled <> "\"}],", "steps = [ S.Step::{strategy = \"symlink\", src = \"{{source}}\", dest = \"" <> destination <> "\", lifecycle = Some \"checkout\", when = Some \"Eq enabled true\"},", "S.Step::{strategy = \"symlink\", src = \"" <> secondSource <> "\", dest = \"" <> secondDestination <> "\", lifecycle = Some \"checkout\"}],", - "commands = [S.Command::{run = \"touch command-sentinel\"}] }" + "commands = [S.Command::{action = S.Command.Action.Apply \"touch command-sentinel\"}] }" ] prepare root home source destination secondSource secondDestination = do @@ -66,9 +87,7 @@ schema <- D.canonicalizePath (takeDirectory cwd "schema") let moduleDir = root ".seihou/modules/demo" D.createDirectoryIfMissing True (moduleDir "schema") - schemaFiles <- D.listDirectory schema - forM_ schemaFiles $ \file -> - if takeExtension file == ".dhall" then D.copyFile (schema file) (moduleDir "schema" file) else pure () + copyPinnedSchema schema (moduleDir "schema") forM_ [source, secondSource, "config/next"] $ \dir -> do D.createDirectoryIfMissing True (root T.unpack dir) TIO.writeFile (root T.unpack dir "sentinel") "source bytes\n" @@ -86,7 +105,9 @@ -- Establish a real old command-producing application, then publish a declaring -- release. Adoption itself runs in a different, empty personal configuration. -prepareAdoption temp failing = do +prepareAdoption temp failing = prepareAdoptionWithTracking temp failing True + +prepareAdoptionWithTracking temp failing tracked = do binary <- seihouBinary cwd <- D.getCurrentDirectory schema <- D.canonicalizePath (takeDirectory cwd "schema") @@ -109,14 +130,13 @@ forM_ [initialHome, home] $ \gitHome -> do _ <- git gitHome ["config", "--file", gitHome ".gitconfig", "url." <> remote <> ".insteadOf", remoteUrl] pure () - files <- D.listDirectory schema - forM_ files $ \file -> if takeExtension file == ".dhall" then D.copyFile (schema file) (remote "schema" file) else pure () + copyPinnedSchema schema (remote "schema") TIO.writeFile (remote "module.dhall") ( moduleBody "1.0.0" "[] : List S.Step.Type" - "[S.Command::{run = \"mkdir -p .local && ln -s ../config/editor .local/config\"}]" + "[S.Command::{action = S.Command.Action.Apply \"mkdir -p .local && ln -s ../config/editor .local/config\"}]" ) _ <- git remote ["init", "-q"] _ <- commit remote "test: publish command producer" @@ -127,9 +147,12 @@ _ <- success binary root initialHome ["install", remoteUrl] _ <- success binary root initialHome ["run", "demo", "--force"] D.createDirectoryLink "../config/editor" (root ".local/unrelated") - _ <- git root ["add", "-f", ".local/config", ".local/unrelated"] + when tracked $ do + _ <- git root ["add", "-f", ".local/config"] + pure () + _ <- git root ["add", "-f", ".local/unrelated"] _ <- commit root "test: record legacy application and discovery links" - let commands = if failing then "[S.Command::{run = \"exit 42\"}]" else "[] : List S.Command.Type" + let commands = if failing then "[S.Command::{action = S.Command.Action.Apply \"exit 42\"}]" else "[] : List S.Command.Type" TIO.writeFile (remote "module.dhall") ( moduleBody @@ -140,14 +163,332 @@ _ <- commit remote "test: publish checkout declarations" pure (binary, root, home) +-- A small command-only producer using the same schema and compiler as all modules. +setupCommand lifecycle text = "S.Command::{action = S.Command.Action." <> lifecycle <> " \"" <> text <> "\"}" + +commandModuleBody name commands dependencies = + "let S = ./schema/package.dhall in S.Module::{name = \"" <> name <> "\", version = Some \"1.0.0\", commands = [" <> T.intercalate "," commands <> "], dependencies = " <> dependencies <> "}" + tests :: IO TestTree -tests = testSpec "manifest-only checkout sync" $ do +tests = testSpec "checkout sync and adoption" $ do + it "restores recorded checkout commands in a fresh clone without producers or application replay" $ + withSystemTempDirectory "checkout-command-clone" $ \temp -> do + let original = temp "original" + clone = temp "different-checkout" + home = temp "empty-home" + D.createDirectoryIfMissing True original + (binary, moduleDir) <- prepare original home "config/editor" ".editor/config" "shared/assets" ".local/assets" + let action = "< Apply : Text | Checkout : Text >" + command lifecycle text = "{action = " <> action <> "." <> lifecycle <> " \"" <> text <> "\", workDir = None Text, when = None Text}" + body = T.replace "commands = [S.Command::{action = S.Command.Action.Apply \"touch command-sentinel\"}]" ("commands = [" <> command "Checkout" "mkdir -p .local; printf '{{source}}' > .local/setup" <> "," <> command "Apply" "touch command-sentinel" <> "]") (fixtureModule "demo" "config/editor" ".editor/config" "shared/assets" ".local/assets" "2.0.0" "true") + TIO.writeFile (moduleDir "module.dhall") body + _ <- success binary original home ["update", "demo", "--json"] + D.doesPathExist (original "command-sentinel") `shouldReturn` False + TIO.readFile (original ".local/setup") `shouldReturn` "config/editor" + _ <- git original ["add", "."] + _ <- git original ["commit", "-qm", "test: record repeatable setup"] + _ <- git original ["clone", "-q", original, clone] + -- The producer and original checkout are now unavailable to the receiver. + D.renameDirectory original (temp "unavailable-original") + before <- snapshot clone + manifest <- BS.readFile (clone ".seihou/manifest.json") + dry <- success binary clone (temp "receiver-home") ["sync", "--dry-run", "--json"] + dry `shouldSatisfy` isInfixOf "would-run" + D.doesPathExist (clone ".local/setup") `shouldReturn` False + _ <- success binary clone (temp "receiver-home") ["sync"] + TIO.readFile (clone ".local/setup") `shouldReturn` "config/editor" + D.getSymbolicLinkTarget (clone ".editor/config") `shouldReturn` "../config/editor" + D.doesPathExist (clone "command-sentinel") `shouldReturn` False + D.removeFile (clone ".local/setup") + _ <- success binary clone (temp "receiver-home") ["sync"] + TIO.readFile (clone ".local/setup") `shouldReturn` "config/editor" + snapshot clone `shouldReturn` before + BS.readFile (clone ".seihou/manifest.json") `shouldReturn` manifest + + it "keeps command-only updates as no-ops, previews declaration changes and persists disabled setup" $ + withSystemTempDirectory "checkout-command-noop" $ \temp -> do + let root = temp "project"; home = temp "home" + D.createDirectoryIfMissing True root + (binary, moduleDir) <- prepare root home "config/editor" ".editor/config" "shared/assets" ".local/assets" + let body value = commandModuleBody "demo" [setupCommand "Checkout" ("mkdir -p .local; printf '" <> value <> "' > .local/setup")] "[] : List S.Dependency.Type" + TIO.writeFile (moduleDir "module.dhall") (body "first") + _ <- success binary root home ["run", "demo", "--force", "--no-commands"] + D.doesPathExist (root ".local/setup") `shouldReturn` False + manifest <- BS.readFile (root ".seihou/manifest.json") + forM_ [False, True] $ \deleted -> do + when deleted $ do + _ <- success binary root home ["sync"] + D.removeFile (root ".local/setup") + output <- success binary root home ["update", "demo"] + output `shouldSatisfy` isInfixOf "Already up to date." + json <- success binary root home ["update", "demo", "--json"] + json `shouldSatisfy` isInfixOf "not-run-no-update" + BS.readFile (root ".seihou/manifest.json") `shouldReturn` manifest + D.doesPathExist (root ".local/setup") `shouldReturn` False + _ <- success binary root home ["sync"] + TIO.readFile (root ".local/setup") `shouldReturn` "first" + TIO.writeFile (moduleDir "module.dhall") (body "second") + dry <- success binary root home ["update", "demo", "--dry-run", "--json"] + dry `shouldSatisfy` isInfixOf "second" + dry `shouldSatisfy` isInfixOf "\"alreadyUpToDate\":false" + _ <- success binary root home ["update", "demo", "--no-commands", "--json"] + TIO.readFile (root ".local/setup") `shouldReturn` "first" + _ <- success binary root home ["sync"] + TIO.readFile (root ".local/setup") `shouldReturn` "second" + D.removeFile (root ".local/setup") + _ <- success binary root home ["update", "demo", "--run-all-commands", "--json"] + TIO.readFile (root ".local/setup") `shouldReturn` "second" + + it "reports a completed prefix and unrun tail, then repeats setup on retry without receipts" $ + withSystemTempDirectory "checkout-command-retry" $ \temp -> do + let root = temp "project"; home = temp "home" + D.createDirectoryIfMissing True root + (binary, moduleDir) <- prepare root home "config/editor" ".editor/config" "shared/assets" ".local/assets" + TIO.writeFile + (moduleDir "module.dhall") + ( commandModuleBody + "demo" + [setupCommand "Checkout" "mkdir -p .local; echo prefix > .local/prefix", setupCommand "Checkout" "echo captured-output; test -f .local/allow", setupCommand "Checkout" "echo tail > .local/tail"] + "[] : List S.Dependency.Type" + ) + _ <- success binary root home ["run", "demo", "--force", "--no-commands"] + before <- snapshot root + manifest <- BS.readFile (root ".seihou/manifest.json") + (code, output, _) <- invoke binary root home ["sync", "--json"] + code `shouldSatisfy` (/= ExitSuccess) + (A.eitherDecode (LBS.fromStrict (TE.encodeUtf8 (T.pack output))) :: Either String A.Value) `shouldSatisfy` either (const False) (const True) + forM_ ["succeeded", "failed", "not-run", "captured-output"] $ \expected -> output `shouldSatisfy` isInfixOf expected + D.doesPathExist (root ".local/tail") `shouldReturn` False + TIO.writeFile (root ".local/allow") "retry\n" + D.removeFile (root ".local/prefix") + _ <- success binary root home ["sync"] + TIO.readFile (root ".local/prefix") `shouldReturn` "prefix\n" + TIO.readFile (root ".local/tail") `shouldReturn` "tail\n" + snapshot root `shouldReturn` before + BS.readFile (root ".seihou/manifest.json") `shouldReturn` manifest + + it "removes a command-only dependency instance without a producer while retaining sibling setup" $ + withSystemTempDirectory "checkout-command-remove" $ \temp -> do + let root = temp "project"; home = temp "home" + D.createDirectoryIfMissing True root + (binary, moduleDir) <- prepare root home "config/editor" ".editor/config" "shared/assets" ".local/assets" + let child = root ".seihou/modules/child" + D.createDirectoryIfMissing True (child "schema") + schemaFiles <- D.listDirectory (moduleDir "schema") + forM_ schemaFiles $ \file -> D.copyFile (moduleDir "schema" file) (child "schema" file) + TIO.writeFile (child "module.dhall") (commandModuleBody "child" [setupCommand "Checkout" "mkdir -p .local; echo child > .local/child; echo child >> .local/order"] "[] : List S.Dependency.Type") + TIO.writeFile (moduleDir "module.dhall") (commandModuleBody "demo" [setupCommand "Checkout" "mkdir -p .local; echo parent > .local/parent; echo parent >> .local/order"] "[S.Dependency::{module = \"child\"}]") + _ <- success binary root home ["run", "demo", "--force"] + TIO.readFile (root ".local/order") `shouldReturn` "child\nparent\n" + D.renameDirectory (root ".seihou/modules") (temp "unavailable-producers") + _ <- success binary root home ["remove", "child", "--force"] + D.removeFile (root ".local/child") + D.removeFile (root ".local/parent") + _ <- success binary root home ["sync"] + D.doesPathExist (root ".local/child") `shouldReturn` False + TIO.readFile (root ".local/parent") `shouldReturn` "parent\n" + + forM_ ["Apply", "Checkout"] $ \failingLifecycle -> do + it ("retains accepted run declarations after " <> T.unpack failingLifecycle <> " failure and sync retries only setup") $ + withSystemTempDirectory "checkout-run-failure" $ \temp -> do + let root = temp "project"; home = temp "home" + D.createDirectoryIfMissing True root + (binary, moduleDir) <- prepare root home "config/editor" ".editor/config" "shared/assets" ".local/assets" + TIO.writeFile + (moduleDir "module.dhall") + ( commandModuleBody + "demo" + [setupCommand "Checkout" "mkdir -p .local; echo prefix > .local/prefix", setupCommand failingLifecycle "test -f .local/allow", setupCommand "Checkout" "echo tail > .local/tail"] + "[] : List S.Dependency.Type" + ) + (code, _, _) <- invoke binary root home ["run", "demo", "--force"] + code `shouldSatisfy` (/= ExitSuccess) + recorded <- TIO.readFile (root ".seihou/manifest.json") + recorded `shouldSatisfy` T.isInfixOf "echo prefix" + recorded `shouldSatisfy` T.isInfixOf "echo tail" + if failingLifecycle == "Checkout" then recorded `shouldSatisfy` T.isInfixOf "test -f .local/allow" else recorded `shouldNotSatisfy` T.isInfixOf "test -f .local/allow" + D.doesPathExist (root ".local/tail") `shouldReturn` False + when (failingLifecycle == "Checkout") $ TIO.writeFile (root ".local/allow") "retry\n" + _ <- success binary root home ["sync"] + TIO.readFile (root ".local/tail") `shouldReturn` "tail\n" + TIO.readFile (root ".seihou/manifest.json") `shouldReturn` recorded + + it ("rolls back proposed checkout declarations on " <> T.unpack failingLifecycle <> " update failure") $ + withSystemTempDirectory "checkout-update-failure" $ \temp -> do + let root = temp "project"; home = temp "home" + D.createDirectoryIfMissing True root + (binary, moduleDir) <- prepare root home "config/editor" ".editor/config" "shared/assets" ".local/assets" + TIO.writeFile (moduleDir "module.dhall") (commandModuleBody "demo" [setupCommand "Checkout" "mkdir -p .local; echo accepted > .local/accepted"] "[] : List S.Dependency.Type") + _ <- success binary root home ["run", "demo", "--force"] + manifest <- BS.readFile (root ".seihou/manifest.json") + before <- snapshot root + TIO.writeFile + (moduleDir "module.dhall") + ( commandModuleBody + "demo" + [setupCommand "Checkout" "mkdir -p .local; echo proposed > .local/proposed", setupCommand failingLifecycle "exit 42", setupCommand "Checkout" "echo tail > .local/tail"] + "[] : List S.Dependency.Type" + ) + (code, _, _) <- invoke binary root home ["update", "demo", "--json"] + code `shouldSatisfy` (/= ExitSuccess) + BS.readFile (root ".seihou/manifest.json") `shouldReturn` manifest + snapshot root `shouldReturn` before + TIO.readFile (root ".local/proposed") `shouldReturn` "proposed\n" + D.removeFile (root ".local/accepted") + _ <- success binary root home ["sync"] + TIO.readFile (root ".local/accepted") `shouldReturn` "accepted\n" + D.doesPathExist (root ".local/tail") `shouldReturn` False + + it "preflights all working directories and rechecks each after earlier checkout shell" $ + withSystemTempDirectory "checkout-command-workdir" $ \temp -> do + let root = temp "project"; home = temp "home" + D.createDirectoryIfMissing True root + (binary, moduleDir) <- prepare root home "config/editor" ".editor/config" "shared/assets" ".local/assets" + D.createDirectoryIfMissing True (root ".local/wd") + let second = "S.Command::{action = S.Command.Action.Checkout \"touch launched\", workDir = Some \".local/wd\"}" + TIO.writeFile + (moduleDir "module.dhall") + ( commandModuleBody + "demo" + [setupCommand "Checkout" "mv .local/wd .local/real; ln -s real .local/wd", second, setupCommand "Checkout" "touch .local/tail"] + "[] : List S.Dependency.Type" + ) + _ <- success binary root home ["run", "demo", "--force", "--no-commands"] + (code, output, _) <- invoke binary root home ["sync", "--json"] + code `shouldSatisfy` (/= ExitSuccess) + forM_ ["succeeded", "failed", "not-run", "existing real directory"] $ \expected -> output `shouldSatisfy` isInfixOf expected + D.doesPathExist (root ".local/real/launched") `shouldReturn` False + D.doesPathExist (root ".local/tail") `shouldReturn` False + -- A subsequent preflight rejects the symlink before even the first command. + (again, _, _) <- invoke binary root home ["sync", "--dry-run"] + again `shouldSatisfy` (/= ExitSuccess) + + forM_ ["run", "update"] $ \mode -> + it ("records checkout declarations under " <> T.unpack mode <> " --no-commands for a fresh teammate clone") $ + withSystemTempDirectory "checkout-disabled-clone" $ \temp -> do + let root = temp "project"; home = temp "home"; clone = temp "teammate" + D.createDirectoryIfMissing True root + (binary, moduleDir) <- prepare root home "config/editor" ".editor/config" "shared/assets" ".local/assets" + TIO.writeFile (moduleDir "module.dhall") (commandModuleBody "demo" [setupCommand "Checkout" "mkdir -p .local; echo setup > .local/setup", setupCommand "Apply" "touch command-sentinel"] "[] : List S.Dependency.Type") + _ <- success binary root home (if mode == "run" then ["run", "demo", "--force", "--no-commands"] else ["update", "demo", "--no-commands", "--json"]) + D.doesPathExist (root ".local/setup") `shouldReturn` False + _ <- git root ["add", "."] + _ <- git root ["commit", "-qm", "test: share disabled checkout declarations"] + _ <- git root ["clone", "-q", root, clone] + before <- snapshot clone + _ <- success binary clone (temp "empty-receiver") ["sync"] + TIO.readFile (clone ".local/setup") `shouldReturn` "setup\n" + D.doesPathExist (clone "command-sentinel") `shouldReturn` False + snapshot clone `shouldReturn` before + + it "refuses an actual interrupted update until the documented recovery entry restores prior files" $ + withSystemTempDirectory "checkout-sync-recovery" $ \temp -> do + let root = temp "project"; home = temp "home" + D.createDirectoryIfMissing True root + (binary, _) <- prepare root home "config/editor" ".editor/config" "shared/assets" ".local/assets" + manifest <- BS.readFile (root ".seihou/manifest.json") + transaction <- beginUpdateTransaction root (Set.singleton "config/editor/sentinel") + transaction `shouldSatisfy` either (const False) (const True) + TIO.writeFile (root "config/editor/sentinel") "interrupted write\n" + D.removeDirectoryLink (root ".editor/config") + forM_ [["sync"], ["sync", "--dry-run"]] $ \args -> do + (code, output, _) <- invoke binary root home args + code `shouldSatisfy` (/= ExitSuccess) + output `shouldSatisfy` isInfixOf "seihou update --dry-run" + TIO.readFile (root "config/editor/sentinel") `shouldReturn` "interrupted write\n" + D.doesPathExist (root ".editor/config") `shouldReturn` False + BS.readFile (root ".seihou/manifest.json") `shouldReturn` manifest + _ <- success binary root home ["update", "demo", "--dry-run"] + TIO.readFile (root "config/editor/sentinel") `shouldReturn` "source bytes\n" + _ <- success binary root home ["sync"] + D.getSymbolicLinkTarget (root ".editor/config") `shouldReturn` "../config/editor" + BS.readFile (root ".seihou/manifest.json") `shouldReturn` manifest + + it "keeps empty sync read-only, then adopts through update and restores a teammate clone" $ + withSystemTempDirectory "sync-team-adoption" $ \temp -> do + (binary, original, home) <- prepareAdoptionWithTracking temp False False + let root = temp "older-clone" + _ <- git original ["clone", "-q", original, root] + before <- snapshot root + D.doesPathExist (root ".local/config") `shouldReturn` False + status <- success binary root home ["status"] + status `shouldSatisfy` isInfixOf "Checkout outputs: none declared." + status `shouldSatisfy` isInfixOf "No checkout effects are recorded" + forM_ [["sync"], ["sync", "--dry-run"], ["sync", "--json"]] $ \args -> do + output <- success binary root home args + output `shouldSatisfy` isInfixOf "No checkout effects are recorded" + snapshot root `shouldReturn` before + D.doesPathExist (root ".local/config") `shouldReturn` False + _ <- success binary root home ["update", "demo", "--json"] + D.getSymbolicLinkTarget (root ".local/config") `shouldReturn` "../config/editor" + TIO.readFile (root ".local/config/sentinel") `shouldReturn` "tracked source\n" + _ <- git root ["add", ".seihou"] + _ <- git root ["-c", "user.name=Test", "-c", "user.email=test@example.invalid", "commit", "-qm", "test: share link setup"] + let clone = temp "teammate"; cloneHome = temp "teammate-home" + D.createDirectoryIfMissing True cloneHome + _ <- git root ["clone", "-q", root, clone] + cloneBefore <- snapshot clone + first <- success binary clone cloneHome ["sync"] + first `shouldSatisfy` isInfixOf "Links: 1 created, 0 repaired, 0 unchanged." + second <- success binary clone cloneHome ["sync"] + second `shouldSatisfy` isInfixOf "Links: 0 created, 0 repaired, 1 unchanged." + snapshot clone `shouldReturn` cloneBefore + D.doesDirectoryExist (cloneHome "config/seihou/installed") `shouldReturn` False + it "adopts tracked links through update while preserving unrelated staging" $ + withSystemTempDirectory "sync-tracked-adoption" $ \temp -> do + (binary, root, home) <- prepareAdoption temp False + TIO.writeFile (root "unrelated") "staged edit\n" + _ <- git root ["add", "unrelated"] + TIO.writeFile (root "unrelated") "unstaged edit\n" + dry <- success binary root home ["update", "demo", "--dry-run"] + dry `shouldSatisfy` isInfixOf "Adopt link: .local/config" + _ <- success binary root home ["update", "demo", "--json"] + git root ["ls-files", "--", ".local/config"] `shouldReturn` "" + git root ["show", ":unrelated"] `shouldReturn` "staged edit\n" + TIO.readFile (root "unrelated") `shouldReturn` "unstaged edit\n" + D.getSymbolicLinkTarget (root ".local/config") `shouldReturn` "../config/editor" + it "does not upgrade or prompt for an unrelated application during link setup" $ + withSystemTempDirectory "sync-unrelated-application" $ \temp -> do + (binary, root, home) <- prepareAdoption temp False + let other = root ".seihou/modules/other" + body version vars = "let S = ./schema/package.dhall in S.Module::{name = \"other\", version = Some \"" <> version <> "\", vars = " <> vars <> ", steps = [S.Step::{strategy = \"copy\", src = \"sentinel\", dest = \"other-output\"}]}" + D.createDirectoryIfMissing True (other "files") + D.createDirectoryIfMissing True (other "schema") + schemaFiles <- D.listDirectory (temp "producer/schema") + forM_ schemaFiles $ \file -> D.copyFile (temp "producer/schema" file) (other "schema" file) + TIO.writeFile (other "files/sentinel") "original other output\n" + TIO.writeFile (other "module.dhall") (body "1.0.0" "[] : List S.VarDecl.Type") + _ <- success binary root home ["run", "other", "--force"] + oldManifest <- A.eitherDecode <$> LBS.readFile (root ".seihou/manifest.json") + TIO.writeFile (other "files/sentinel") "unrelated proposed update\n" + TIO.writeFile (other "module.dhall") (body "2.0.0" "[S.VarDecl::{name = \"new-input\", type = \"text\", required = True}]") + _ <- success binary root home ["update", "demo", "--json"] + TIO.readFile (root "other-output") `shouldReturn` "original other output\n" + newManifest <- A.eitherDecode <$> LBS.readFile (root ".seihou/manifest.json") + let otherApplication decoded = case decoded of + Right (A.Object fields) -> case KM.lookup "applications" fields of + Just (A.Array applications) -> [app | app@(A.Object values) <- foldr (:) [] applications, KM.lookup "target" values == Just (A.object ["kind" A..= ("module" :: T.Text), "name" A..= ("other" :: T.Text)])] + _ -> [] + _ -> [] + length (otherApplication oldManifest) `shouldBe` 1 + otherApplication newManifest `shouldBe` otherApplication oldManifest + it "refuses occupied directories during adoption without losing user files" $ + withSystemTempDirectory "sync-adoption-collision" $ \temp -> do + (binary, root, home) <- prepareAdoptionWithTracking temp False False + D.removeDirectoryLink (root ".local/config") + D.createDirectoryIfMissing True (root ".local/config") + TIO.writeFile (root ".local/config/user-file") "keep me\n" + before <- snapshot root + (code, _, _) <- invoke binary root home ["update", "demo", "--json"] + code `shouldSatisfy` (/= ExitSuccess) + snapshot root `shouldReturn` before + TIO.readFile (root ".local/config/user-file") `shouldReturn` "keep me\n" it "adopts a tracked link using remote update alone, then syncs a fresh clone" $ withSystemTempDirectory "checkout-adoption" $ \temp -> do (binary, root, home) <- prepareAdoption temp False D.doesDirectoryExist (home "config/seihou/installed") `shouldReturn` False - notice <- success binary root home ["sync"] - notice `shouldSatisfy` isInfixOf "seihou update demo" + notice <- success binary root home ["sync", "--dry-run"] + notice `shouldSatisfy` isInfixOf "No checkout effects are recorded" TIO.writeFile (root "unrelated") "staged edit\n" _ <- git root ["add", "unrelated"] TIO.writeFile (root "unrelated") "unstaged edit\n" diff --git a/test/Seihou/CLI/CheckoutSyncSpec.hs b/test/Seihou/CLI/CheckoutSyncSpec.hs --- a/test/Seihou/CLI/CheckoutSyncSpec.hs +++ b/test/Seihou/CLI/CheckoutSyncSpec.hs @@ -17,7 +17,7 @@ tests :: IO TestTree tests = testSpec "checkout reports" $ do let entry action = CheckoutEntry ".local/config" Nothing Nothing (CheckoutObservation EntryMissing True [] True True) action [] [] - result dry plan outcomes = CheckoutSyncResult "/project" dry plan (CheckoutExecution outcomes [] Nothing) [] + result dry plan outcomes = CheckoutSyncResult "/project" dry plan (CheckoutExecution outcomes [] Nothing) [] [] [] it "distinguishes proposed dry-run work from successful writes" $ do let report = checkoutReportJSON (result True (CheckoutPlan [entry CreateLink]) Map.empty) case report of diff --git a/test/Seihou/CLI/CommandExecutionSpec.hs b/test/Seihou/CLI/CommandExecutionSpec.hs --- a/test/Seihou/CLI/CommandExecutionSpec.hs +++ b/test/Seihou/CLI/CommandExecutionSpec.hs @@ -4,7 +4,7 @@ import Data.Map.Strict qualified as Map import Data.Maybe (fromJust) import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError) -import Effectful (runPureEff) +import Effectful (runEff) import Seihou.CLI.CommandExecution import Seihou.Core.CommandFingerprint (fingerprintCommand) import Seihou.Core.Types @@ -26,7 +26,7 @@ commandOp :: Text -> Maybe FilePath -> ModuleName -> Int -> Operation commandOp command workDir moduleName occurrence = - RunCommandOp {command, workDir, moduleName, occurrence} + RunCommandOp {command, workDir, moduleName, occurrence, lifecycle = ApplicationCommand} fingerprintOf :: Operation -> CommandFingerprint fingerprintOf = fromJust . fingerprintCommand @@ -78,6 +78,14 @@ map (^. #disposition) (plan ^. #commands) `shouldBe` [CommandSkippedUnchanged, CommandWillRun] + it "never lets an application receipt suppress or become checkout completion" $ do + let ordinary = commandOp "echo same" Nothing "app" 0 + checkout = RunCommandOp "echo same" Nothing "app" 0 CheckoutCommandLifecycle + prior = Map.singleton (fingerprintOf ordinary) (receiptFor fixedTime ordinary) + plan = planCommands RunChangedCommands prior [checkout, ordinary] + map (^. #disposition) (plan ^. #commands) `shouldBe` [CommandWillRun, CommandSkippedUnchanged] + finalizeCommandReceipts (planCommands DisableCommands prior [checkout]) [] prior `shouldBe` Map.empty + 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 @@ -89,10 +97,10 @@ 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 + result <- + runEff $ + runProcessPure [successMock "echo first", successMock "echo second"] $ + executeCommandPlan laterTime plan case result of Right receipts -> do map (^. #fingerprint) receipts `shouldBe` map fingerprintOf [first, second] @@ -104,7 +112,7 @@ priorReceipt = receiptFor fixedTime operation prior = Map.singleton (priorReceipt ^. #fingerprint) priorReceipt plan = planCommands RunChangedCommands prior [operation] - result = runPureEff $ runProcessPure [] $ executeCommandPlan laterTime plan + result <- runEff $ runProcessPure [] $ executeCommandPlan laterTime plan result `shouldBe` Right [] it "returns a structured error at the first failure" $ do @@ -119,7 +127,7 @@ }, successMock "echo later" ] - result = runPureEff $ runProcessPure mocks $ executeCommandPlan laterTime plan + result <- runEff $ runProcessPure mocks $ executeCommandPlan laterTime plan case result of Left err -> do (err ^. #exitCode) `shouldBe` 7 diff --git a/test/Seihou/CLI/DiffSpec.hs b/test/Seihou/CLI/DiffSpec.hs --- a/test/Seihou/CLI/DiffSpec.hs +++ b/test/Seihou/CLI/DiffSpec.hs @@ -18,21 +18,21 @@ [ TrackedFile "README.md" (ModuleName "haskell-base") TfsUnchanged, TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsUnchanged ] - result = formatDiffOutput False tracked + result = formatDiffOutput False tracked 0 result `shouldBe` "No changes since last generation.\n" it "includes header line" $ do let tracked = [ TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsModified ] - result = formatDiffOutput False tracked + result = formatDiffOutput False tracked 0 T.isInfixOf "Seihou Diff:" result `shouldBe` True it "shows modified files" $ do let tracked = [ TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsModified ] - result = formatDiffOutput False tracked + result = formatDiffOutput False tracked 0 T.isInfixOf "modified" result `shouldBe` True T.isInfixOf "src/Lib.hs" result `shouldBe` True @@ -40,7 +40,7 @@ let tracked = [ TrackedFile "app/Main.hs" (ModuleName "haskell-base") TfsDeleted ] - result = formatDiffOutput False tracked + result = formatDiffOutput False tracked 0 T.isInfixOf "deleted" result `shouldBe` True T.isInfixOf "app/Main.hs" result `shouldBe` True @@ -50,14 +50,14 @@ TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsModified, TrackedFile "app/Main.hs" (ModuleName "haskell-base") TfsDeleted ] - result = formatDiffOutput False tracked + result = formatDiffOutput False tracked 0 T.isInfixOf "1 unchanged, 1 modified, 1 deleted" result `shouldBe` True it "shows module attribution in parentheses" $ do let tracked = [ TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsModified ] - result = formatDiffOutput False tracked + result = formatDiffOutput False tracked 0 T.isInfixOf "(haskell-base)" result `shouldBe` True it "hides unchanged files from main listing" $ do @@ -65,6 +65,9 @@ [ TrackedFile "README.md" (ModuleName "haskell-base") TfsUnchanged, TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsModified ] - result = formatDiffOutput False tracked + result = formatDiffOutput False tracked 0 bodyLines = filter (T.isInfixOf "README.md") (T.lines result) bodyLines `shouldBe` [] + + it "counts receipts without inventing seed drift or listing paths" $ do + formatDiffOutput False [] 3 `shouldBe` "No changes since last generation.\n3 seed files not compared\n" diff --git a/test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs b/test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs --- a/test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs +++ b/test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs @@ -52,6 +52,7 @@ context = Nothing, instances = [], commandReceipts = Map.empty, + checkoutCommands = [], appliedAt = testTime } @@ -110,6 +111,28 @@ spec :: Spec spec = do + describe "legacy seed ownership evidence" $ do + let instanceState name = AppliedInstanceState name emptyParentVars (LocalOrigin (name ^. #unModuleName)) (Just "1.0.0") Map.empty + app = recordedApplication appA & #instances .~ map instanceState ["first", "second"] + receipt = SeedRecord "first" (LegacySeedOwners (Set.singleton appA)) SeedCreated testTime + old = emptyManifest testTime & #applications .~ [app] & #seeds .~ Map.singleton "a.txt" receipt + evidence = Map.singleton appA (Right (Map.singleton "a.txt" (Set.fromList ["first", "second"]))) + it "infers every co-seeder from an injected recorded-evidence provider" $ do + result <- prepareSeedOwnership (Set.singleton "a.txt") old $ \wanted -> do + wanted `shouldBe` Set.singleton appA + pure evidence + case result of + Left err -> expectationFailure (T.unpack err) + Right prepared -> do + fmap (^. #ownership) (Map.lookup "a.txt" (prepared ^. #seeds)) `shouldBe` Just (KnownSeedOwners (Map.singleton appA (Set.fromList ["first", "second"]))) + fmap (^. #moduleName) (Map.lookup "a.txt" (prepared ^. #seeds)) `shouldBe` Just "first" + it "preserves unrequested unknown receipts without asking for evidence" $ do + result <- prepareSeedOwnership Set.empty old (\_ -> expectationFailure "unexpected evidence lookup" >> pure Map.empty) + result `shouldBe` Right old + it "refuses absent, unavailable, and impossible evidence with an actionable path" $ do + let failures = [Map.empty, Map.singleton appA (Left "recorded release unavailable"), Map.singleton appA (Right Map.empty), Map.singleton appA (Right (Map.singleton "a.txt" (Set.singleton "unrecorded")))] + mapM_ (\e -> resolveLegacySeedOwnership (Set.singleton "a.txt") old e `shouldSatisfy` either (T.isInfixOf "a.txt") (const False)) failures + describe "certifySharedWriteModes" $ do let everything = certifySharedWriteModes CertifyAllUnknownPaths fixtureManifest evidence @@ -269,7 +292,7 @@ case manifestFromJSON written of Left err -> expectationFailure err Right upgraded -> do - (upgraded ^. #version) `shouldBe` ManifestSchemaVersion 9 + (upgraded ^. #version) `shouldBe` ManifestSchemaVersion 11 (^. #sharedWriteMode) <$> Map.lookup ".gitignore" (upgraded ^. #files) `shouldBe` Just SharedWriteAdditiveOnly TIO.readFile (fixture ^. #gitignorePath) `shouldReturn` gitignoreBefore diff --git a/test/Seihou/CLI/ManifestRepairOriginsSpec.hs b/test/Seihou/CLI/ManifestRepairOriginsSpec.hs --- a/test/Seihou/CLI/ManifestRepairOriginsSpec.hs +++ b/test/Seihou/CLI/ManifestRepairOriginsSpec.hs @@ -58,6 +58,7 @@ context = Nothing, instances = [AppliedInstanceState "beta" emptyParentVars (origin localPath "beta") (Just "1.0.0") Map.empty], commandReceipts = Map.empty, + checkoutCommands = [], appliedAt = testTime } receipt = diff --git a/test/Seihou/CLI/ManifestUpgradeSpec.hs b/test/Seihou/CLI/ManifestUpgradeSpec.hs --- a/test/Seihou/CLI/ManifestUpgradeSpec.hs +++ b/test/Seihou/CLI/ManifestUpgradeSpec.hs @@ -264,12 +264,12 @@ outcome <- runManifestUpgrade (opts False False Nothing) case outcome of UpgradeWritten result -> do - map stepVersions (result ^. #steps) `shouldBe` [(6, 7), (7, 8), (8, 9)] + map stepVersions (result ^. #steps) `shouldBe` [(6, 7), (7, 8), (8, 9), (9, 10), (10, 11)] (result ^. #entries) `shouldBe` [] - (result ^. #toVersion) `shouldBe` ManifestSchemaVersion 9 + (result ^. #toVersion) `shouldBe` ManifestSchemaVersion 11 other -> expectationFailure ("expected a write, got " <> show other) document <- readDocument manifestPath - lookupPath ["version"] document `shouldBe` Just (Aeson.Number 9) + lookupPath ["version"] document `shouldBe` Just (Aeson.Number 11) lookupPath ["files", ".gitignore", "sharedWriteMode"] document `shouldBe` Just (Aeson.String "additive-only") lookupPath ["files", "README.md", "sharedWriteMode"] document `shouldBe` Just (Aeson.String "unknown") lookupPath ["files", ".gitignore", "additiveOnly"] document `shouldBe` Nothing @@ -281,7 +281,7 @@ before <- LBS.readFile manifestPath outcome <- runManifestUpgrade (opts False False Nothing) case outcome of - UpgradeNotNeeded version _ -> version `shouldBe` ManifestSchemaVersion 9 + UpgradeNotNeeded version _ -> version `shouldBe` ManifestSchemaVersion 11 other -> expectationFailure ("expected nothing to do, got " <> show other) LBS.readFile manifestPath `shouldReturn` before @@ -310,7 +310,7 @@ outcome <- runManifestUpgrade (opts True True Nothing) case outcome of UpgradeWouldWrite result [] -> do - map stepVersions (result ^. #steps) `shouldBe` [(5, 6), (6, 7), (7, 8), (8, 9)] + map stepVersions (result ^. #steps) `shouldBe` [(5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11)] map (^. #artifactName) (result ^. #entries) `shouldBe` ["haskell-base", "project-lint", "haskell-service", "scratch-helper"] let report = formatUpgradeReport result @@ -335,14 +335,14 @@ outcome <- runManifestUpgrade (opts False True Nothing) case outcome of UpgradeWritten result -> - map stepVersions (result ^. #steps) `shouldBe` [(2, 3), (3, 4), (4, 5), (5, 6), (6, 7), (7, 8), (8, 9)] + map stepVersions (result ^. #steps) `shouldBe` [(2, 3), (3, 4), (4, 5), (5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11)] other -> expectationFailure ("expected a write, got " <> show other) document <- readDocument manifestPath - lookupPath ["version"] document `shouldBe` Just (Aeson.Number 9) + lookupPath ["version"] document `shouldBe` Just (Aeson.Number 11) it "rejects a target newer than this build or older than the document" $ do withUpgradeProject schema6Manifest $ \_ -> - runManifestUpgrade (opts False False (Just (ManifestSchemaVersion 99))) + runManifestUpgrade (opts False False (Just (ManifestSchemaVersion 109))) >>= (`shouldSatisfy` isFailure) withUpgradeProject schema6Manifest $ \_ -> runManifestUpgrade (opts False False (Just (ManifestSchemaVersion 5))) @@ -366,7 +366,7 @@ output `shouldSatisfy` T.isInfixOf "5 -> 6" output `shouldSatisfy` T.isInfixOf "6 -> 7" document <- readDocument manifestPath - lookupPath ["version"] document `shouldBe` Just (Aeson.Number 9) + lookupPath ["version"] document `shouldBe` Just (Aeson.Number 11) lookupPath ["modules", "0", "origin"] document `shouldBe` Just (Aeson.toJSON (RemoteOrigin "https://example.com/demo-modules.git" "demo" (Just "demo-modules"))) filter absoluteLooking (documentStrings document) `shouldBe` [] diff --git a/test/Seihou/CLI/SeedRunE2ESpec.hs b/test/Seihou/CLI/SeedRunE2ESpec.hs new file mode 100644 --- /dev/null +++ b/test/Seihou/CLI/SeedRunE2ESpec.hs @@ -0,0 +1,206 @@ +module Seihou.CLI.SeedRunE2ESpec (tests, prepare, body, invoke, success, readManifest) where + +import Control.Monad (forM_) +import Data.Aeson qualified as A +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as LBS +import Data.Generics.Labels () +import Data.Map.Strict qualified as Map +import Data.Text qualified as T +import Data.Text.IO qualified as TIO +import Seihou.CLI.CheckoutSyncE2ESpec (copyPinnedSchema) +import Seihou.CLI.SeihouBinary (seihouBinary) +import Seihou.Core.Types +import Seihou.Manifest.Types (manifestFromJSON) +import Seihou.Prelude +import System.Directory qualified as D +import System.Environment (getEnvironment) +import System.Exit (ExitCode (..)) +import System.FilePath (takeDirectory) +import System.IO.Temp (withSystemTempDirectory) +import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode) +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec (testSpec) + +invoke binary root args = do + inherited <- getEnvironment + let overrides = [("HOME", root "home"), ("XDG_CONFIG_HOME", root "config"), ("XDG_CACHE_HOME", root "cache")] + readCreateProcessWithExitCode (proc binary args) {cwd = Just root, env = Just (overrides <> filter (\(key, _) -> key `notElem` map fst overrides) inherited)} "" + +success binary root args = do + (code, out, err) <- invoke binary root args + unlessSuccess code (T.pack (out <> err)) + pure (T.pack (out <> err)) + where + unlessSuccess ExitSuccess _ = pure () + unlessSuccess _ output = expectationFailure (unwords args <> ": " <> T.unpack output) + +body lifecycle extra = "let S = ./schema/package.dhall in S.Module::{name=\"demo\", version=Some \"1.0.0\", steps=[S.Step::{strategy=\"copy\",src=\"starter\",dest=\"nested/start.txt\",lifecycle=Some \"" <> lifecycle <> "\"},S.Step::{strategy=\"copy\",src=\"license\",dest=\"LICENSE\"}] " <> extra <> "}" + +prepare root = do + binary <- seihouBinary + cwd <- D.getCurrentDirectory + schema <- D.canonicalizePath (takeDirectory cwd "schema") + let modul = root ".seihou/modules/demo" + D.createDirectoryIfMissing True (modul "schema") + D.createDirectoryIfMissing True (modul "files") + copyPinnedSchema schema (modul "schema") + TIO.writeFile (modul "files/starter") "starter\n" + TIO.writeFile (modul "files/license") "license\n" + TIO.writeFile (modul "module.dhall") (body "seed" "") + pure (binary, modul) + +readManifest root = do + bytes <- LBS.readFile (root ".seihou/manifest.json") + case manifestFromJSON bytes of Left err -> fail err; Right manifest -> pure manifest + +tests :: IO TestTree +tests = testSpec "seed run end-to-end" $ do + it "creates once, preserves forced edits and deliberate deletion without parent resurrection" $ + withSystemTempDirectory "seed-run" $ \root -> do + (binary, _) <- prepare root + first <- success binary root ["run", "demo"] + first `shouldSatisfy` T.isInfixOf "create once nested/start.txt" + manifest <- readManifest root + Map.member "nested/start.txt" (manifest ^. #seeds) `shouldBe` True + Map.member "nested/start.txt" (manifest ^. #files) `shouldBe` False + TIO.writeFile (root "nested/start.txt") "project changes\n" + _ <- success binary root ["run", "demo", "--force"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "project changes\n" + D.removeFile (root "nested/start.txt") + D.removeDirectory (root "nested") + deleted <- success binary root ["run", "demo", "--force"] + deleted `shouldSatisfy` T.isInfixOf "keep deleted nested/start.txt" + D.doesPathExist (root "nested") `shouldReturn` False + it "keeps a pre-existing regular file without force and makes previews immutable" $ + withSystemTempDirectory "seed-existing" $ \root -> do + (binary, _) <- prepare root + D.createDirectory (root "nested") + TIO.writeFile (root "nested/start.txt") "already mine\n" + _ <- success binary root ["run", "demo", "--dry-run"] + D.doesPathExist (root ".seihou/manifest.json") `shouldReturn` False + D.doesPathExist (root "LICENSE") `shouldReturn` False + _ <- success binary root ["run", "demo"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "already mine\n" + manifest <- readManifest root + fmap (^. #outcome) (Map.lookup "nested/start.txt" (manifest ^. #seeds)) `shouldBe` Just SeedFoundExisting + before <- BS.readFile (root ".seihou/manifest.json") + _ <- success binary root ["run", "demo", "--diff"] + BS.readFile (root ".seihou/manifest.json") `shouldReturn` before + it "refuses both lifecycle transitions before bytes or applied metadata advance" $ + withSystemTempDirectory "seed-transition" $ \root -> do + (binary, modul) <- prepare root + TIO.writeFile (modul "module.dhall") (body "managed" "") + _ <- success binary root ["run", "demo", "--force"] + before <- BS.readFile (root ".seihou/manifest.json") + TIO.writeFile (modul "module.dhall") (body "seed" "") + (code, _, err) <- invoke binary root ["run", "demo", "--force"] + code `shouldBe` ExitFailure 1 + BS.readFile (root ".seihou/manifest.json") `shouldReturn` before + -- Start the reverse direction in another project so no fixture edits + -- silently perform the transition the public command must refuse. + withSystemTempDirectory "seed-reverse" $ \other -> do + (otherBinary, otherModule) <- prepare other + _ <- success otherBinary other ["run", "demo"] + old <- BS.readFile (other ".seihou/manifest.json") + TIO.writeFile (other "nested/start.txt") "mine\n" + TIO.writeFile (otherModule "module.dhall") (body "managed" "") + (refused, _, _) <- invoke otherBinary other ["run", "demo", "--force"] + refused `shouldBe` ExitFailure 1 + BS.readFile (other ".seihou/manifest.json") `shouldReturn` old + TIO.readFile (other "nested/start.txt") `shouldReturn` "mine\n" + it "refuses directories and dangling links without writing managed siblings" $ + forM_ [False, True] $ \linked -> withSystemTempDirectory "seed-occupied" $ \root -> do + (binary, _) <- prepare root + D.createDirectory (root "nested") + if linked then D.createFileLink "missing" (root "nested/start.txt") else D.createDirectory (root "nested/start.txt") + (code, _, _) <- invoke binary root ["run", "demo", "--force"] + code `shouldBe` ExitFailure 1 + D.doesPathExist (root "LICENSE") `shouldReturn` False + D.doesPathExist (root ".seihou/manifest.json") `shouldReturn` False + + it "records co-seeders in one application and adds another application without changing the supplier" $ + withSystemTempDirectory "seed-coowners" $ \root -> do + (binary, modul) <- prepare root + let child = root ".seihou/modules/child" + D.createDirectoryIfMissing True (child "files") + TIO.writeFile (child "files/starter") "child supplies first\n" + TIO.writeFile (child "module.dhall") "let S = ../demo/schema/package.dhall in S.Module::{name=\"child\", version=Some \"1.0.0\", vars=[S.VarDecl::{name=\"slot\",type=\"text\",default=Some \"base\"}], steps=[S.Step::{strategy=\"copy\",src=\"starter\",dest=\"nested/start.txt\",lifecycle=Some \"seed\"}]}" + TIO.writeFile (modul "module.dhall") (body "seed" ", dependencies=[S.Dependency::{module=\"child\",vars=[{name=\"slot\",value=\"one\"}]},S.Dependency::{module=\"child\",vars=[{name=\"slot\",value=\"two\"}]}]") + _ <- success binary root ["run", "demo"] + first <- readManifest root + let Just firstReceipt = Map.lookup "nested/start.txt" (first ^. #seeds) + case firstReceipt ^. #ownership of + KnownSeedOwners owners -> owners `shouldSatisfy` ((== [3]) . map length . Map.elems) + _ -> expectationFailure "expected exact owners" + firstReceipt ^. #moduleName . #unModuleName `shouldSatisfy` T.isPrefixOf "child#" + TIO.readFile (root "nested/start.txt") `shouldReturn` "child supplies first\n" + let other = root ".seihou/modules/other" + D.createDirectoryIfMissing True (other "files") + D.copyFile (modul "files/starter") (other "files/starter") + D.copyFile (modul "files/license") (other "files/license") + TIO.writeFile (other "module.dhall") (T.replace "./schema/package.dhall" "../demo/schema/package.dhall" (T.replace "name=\"demo\"" "name=\"other\"" (body "seed" ""))) + TIO.writeFile (root "nested/start.txt") "project bytes\n" + _ <- success binary root ["run", "other", "--force"] + shared <- readManifest root + let Just sharedReceipt = Map.lookup "nested/start.txt" (shared ^. #seeds) + sharedReceipt ^. #moduleName `shouldBe` firstReceipt ^. #moduleName + sharedReceipt ^. #settledAt `shouldBe` firstReceipt ^. #settledAt + case sharedReceipt ^. #ownership of + KnownSeedOwners owners -> Map.size owners `shouldBe` 2 + _ -> expectationFailure "expected exact owners" + TIO.readFile (root "nested/start.txt") `shouldReturn` "project bytes\n" + it "retires false-condition claims and permits seeding after final receipt retirement" $ + withSystemTempDirectory "seed-condition" $ \root -> do + (binary, modul) <- prepare root + let conditional = T.replace "lifecycle=Some \"seed\"" "lifecycle=Some \"seed\",when=Some \"Eq enabled true\"" (body "seed" ",vars=[S.VarDecl::{name=\"enabled\",type=\"bool\",default=Some \"true\"}]") + TIO.writeFile (modul "module.dhall") conditional + _ <- success binary root ["run", "demo"] + TIO.writeFile (root "nested/start.txt") "mine\n" + _ <- success binary root ["run", "demo", "--var", "enabled=false"] + retired <- readManifest root + retired ^. #seeds `shouldBe` Map.empty + TIO.readFile (root "nested/start.txt") `shouldReturn` "mine\n" + D.removeFile (root "nested/start.txt") + _ <- success binary root ["run", "demo", "--var", "enabled=true"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "starter\n" + it "uses the same seed handling for an agent blueprint baseline" $ + withSystemTempDirectory "seed-agent" $ \root -> do + (binary, _) <- prepare root + let blueprint = root ".seihou/modules/seed-blueprint" + D.createDirectoryIfMissing True blueprint + TIO.writeFile (blueprint "blueprint.dhall") "let S = ../demo/schema/package.dhall in S.Blueprint::{name=\"seed-blueprint\",version=Some \"1.0.0\",prompt=\"Describe the accepted baseline.\", baseModules = [ S.Dependency::{ module = \"demo\" } ]}" + _ <- success binary root ["agent", "--debug", "run", "seed-blueprint", "--force"] + first <- readManifest root + Map.member "nested/start.txt" (first ^. #seeds) `shouldBe` True + TIO.writeFile (root "nested/start.txt") "agent project changes\n" + _ <- success binary root ["agent", "--debug", "run", "seed-blueprint", "--force"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "agent project changes\n" + D.removeFile (root "nested/start.txt") + _ <- success binary root ["agent", "--debug", "run", "seed-blueprint", "--force"] + D.doesPathExist (root "nested/start.txt") `shouldReturn` False + it "reports receipts without drift and retires a seed-only owner without a removal specification" $ + withSystemTempDirectory "seed-remove" $ \root -> do + (binary, modul) <- prepare root + let seedOnly = T.replace ",S.Step::{strategy=\"copy\",src=\"license\",dest=\"LICENSE\"}" "" (body "seed" "") + TIO.writeFile (modul "module.dhall") seedOnly + _ <- success binary root ["run", "demo"] + TIO.writeFile (root "nested/start.txt") "mine\n" + status <- success binary root ["status"] + status `shouldSatisfy` T.isInfixOf "Seed files: 1" + diff <- success binary root ["diff"] + diff `shouldSatisfy` T.isInfixOf "1 seed files not compared" + diff `shouldSatisfy` (not . T.isInfixOf "nested/start.txt") + before <- BS.readFile (root ".seihou/manifest.json") + preview <- success binary root ["remove", "demo", "--dry-run"] + preview `shouldSatisfy` T.isInfixOf "Keep nested/start.txt" + BS.readFile (root ".seihou/manifest.json") `shouldReturn` before + removed <- success binary root ["remove", "demo", "--force"] + removed `shouldSatisfy` T.isInfixOf "Retired 1 seed claims" + TIO.readFile (root "nested/start.txt") `shouldReturn` "mine\n" + retired <- readManifest root + retired ^. #seeds `shouldBe` Map.empty + D.removeFile (root "nested/start.txt") + _ <- success binary root ["run", "demo"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "starter\n" diff --git a/test/Seihou/CLI/SeedUpdateE2ESpec.hs b/test/Seihou/CLI/SeedUpdateE2ESpec.hs new file mode 100644 --- /dev/null +++ b/test/Seihou/CLI/SeedUpdateE2ESpec.hs @@ -0,0 +1,129 @@ +module Seihou.CLI.SeedUpdateE2ESpec (tests) where + +import Control.Monad (forM_, when) +import Data.ByteString qualified as BS +import Data.Generics.Labels () +import Data.Map.Strict qualified as Map +import Data.Text qualified as T +import Data.Text.IO qualified as TIO +import Seihou.CLI.SeedRunE2ESpec (body, invoke, prepare, readManifest, success) +import Seihou.Core.Types +import Seihou.Prelude +import System.Directory qualified as D +import System.Exit (ExitCode (..)) +import System.IO.Temp (withSystemTempDirectory) +import System.Process (callProcess, readProcess) +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec (testSpec) + +candidate modul lifecycle = TIO.writeFile (modul "module.dhall") (T.replace "1.0.0" "2.0.0" (body lifecycle "")) + +tests :: IO TestTree +tests = testSpec "seed update end-to-end" $ do + it "auto-commits creations and the manifest without staging edits to released files" $ + withSystemTempDirectory "seed-update-commit" $ \root -> do + (binary, modul) <- prepare root + TIO.writeFile (modul "module.dhall") (body "managed" "") + _ <- success binary root ["run", "demo"] + callProcess "git" ["-C", root, "init", "-q"] + callProcess "git" ["-C", root, "config", "user.name", "Seihou Test"] + callProcess "git" ["-C", root, "config", "user.email", "test@example.com"] + callProcess "git" ["-C", root, "add", "."] + callProcess "git" ["-C", root, "commit", "-qm", "test: record managed fixture"] + TIO.writeFile (root "nested/start.txt") "uncommitted project edit\n" + TIO.writeFile (modul "module.dhall") (T.replace "1.0.0" "2.0.0" (T.replace ",S.Step::{strategy=\"copy\",src=\"license\",dest=\"LICENSE\"}" ",S.Step::{strategy=\"copy\",src=\"starter\",dest=\"new.txt\",lifecycle=Some \"seed\"},S.Step::{strategy=\"copy\",src=\"license\",dest=\"LICENSE\"}" (body "seed" ""))) + _ <- success binary root ["update", "demo", "--json", "--commit-message", "chore: adopt seeds"] + committed <- lines <$> readProcess "git" ["-C", root, "show", "--pretty=", "--name-only", "HEAD"] "" + committed `shouldContain` [".seihou/manifest.json", "new.txt"] + committed `shouldNotContain` ["nested/start.txt"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "uncommitted project edit\n" + + it "releases managed edits, absence and replacement directories without touching project state" $ + forM_ ["edited", "missing", "directory"] $ \state -> withSystemTempDirectory "seed-update-release" $ \root -> do + (binary, modul) <- prepare root + TIO.writeFile (modul "module.dhall") (body "managed" "") + _ <- success binary root ["run", "demo"] + case state of + "edited" -> TIO.writeFile (root "nested/start.txt") "project edit\n" + "missing" -> D.removeFile (root "nested/start.txt") + _ -> D.removeFile (root "nested/start.txt") >> D.createDirectory (root "nested/start.txt") + candidate modul "seed" + before <- BS.readFile (root ".seihou/manifest.json") + preview <- success binary root ["update", "demo", "--dry-run"] + preview `shouldSatisfy` T.isInfixOf "release to project nested/start.txt" + BS.readFile (root ".seihou/manifest.json") `shouldReturn` before + _ <- success binary root ["update", "demo", "--json"] + applied <- readManifest root + Map.member "nested/start.txt" (applied ^. #files) `shouldBe` False + fmap (^. #outcome) (Map.lookup "nested/start.txt" (applied ^. #seeds)) `shouldBe` Just SeedReleasedFromManaged + case state of + "edited" -> TIO.readFile (root "nested/start.txt") `shouldReturn` "project edit\n" + "missing" -> D.doesPathExist (root "nested/start.txt") `shouldReturn` False + _ -> D.doesDirectoryExist (root "nested/start.txt") `shouldReturn` True + after <- BS.readFile (root ".seihou/manifest.json") + repeated <- success binary root ["update", "demo", "--json"] + repeated `shouldSatisfy` T.isInfixOf "\"alreadyUpToDate\":true" + BS.readFile (root ".seihou/manifest.json") `shouldReturn` after + + it "creates newly introduced seeds once and preserves deliberate deletion on repeat" $ + withSystemTempDirectory "seed-update-create" $ \root -> do + (binary, modul) <- prepare root + let empty = "let S = ./schema/package.dhall in S.Module::{name=\"demo\",version=Some \"1.0.0\"}" + TIO.writeFile (modul "module.dhall") empty + _ <- success binary root ["run", "demo"] + candidate modul "seed" + _ <- success binary root ["update", "demo", "--json"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "starter\n" + D.removeFile (root "nested/start.txt") + D.removeDirectory (root "nested") + _ <- success binary root ["update", "demo", "--force", "--json"] + D.doesPathExist (root "nested") `shouldReturn` False + + it "retires disappearing claims and seeds an absent path after reintroduction" $ + withSystemTempDirectory "seed-update-retire" $ \root -> do + (binary, modul) <- prepare root + _ <- success binary root ["run", "demo"] + TIO.writeFile (root "nested/start.txt") "mine\n" + TIO.writeFile (modul "module.dhall") "let S = ./schema/package.dhall in S.Module::{name=\"demo\",version=Some \"2.0.0\"}" + _ <- success binary root ["update", "demo", "--json"] + retired <- readManifest root + retired ^. #seeds `shouldBe` Map.empty + TIO.readFile (root "nested/start.txt") `shouldReturn` "mine\n" + D.removeFile (root "nested/start.txt") + TIO.writeFile (modul "module.dhall") (T.replace "1.0.0" "3.0.0" (body "seed" "")) + _ <- success binary root ["update", "demo", "--json"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "starter\n" + + it "requires explicit adoption even for equal bytes, and force or JSON cannot consent" $ + forM_ [False, True] $ \missing -> withSystemTempDirectory "seed-update-adopt" $ \root -> do + (binary, modul) <- prepare root + _ <- success binary root ["run", "demo"] + when missing (D.removeFile (root "nested/start.txt")) + candidate modul "managed" + before <- BS.readFile (root ".seihou/manifest.json") + forM_ [["--json"], ["--force", "--json"]] $ \flags -> do + (code, out, _) <- invoke binary root (["update", "demo"] <> flags) + code `shouldBe` ExitFailure 1 + T.pack out `shouldSatisfy` T.isInfixOf "seed_adoption_requires_interaction" + BS.readFile (root ".seihou/manifest.json") `shouldReturn` before + D.doesFileExist (root "nested/start.txt") `shouldReturn` not missing + + it "rejects mixed candidate lifecycles after expanding shared managed owners" $ + withSystemTempDirectory "seed-update-shared" $ \root -> do + (binary, modul) <- prepare root + TIO.writeFile (modul "module.dhall") (body "managed" "") + _ <- success binary root ["run", "demo"] + let other = root ".seihou/modules/other" + D.createDirectoryIfMissing True (other "files") + D.copyFile (modul "files/starter") (other "files/starter") + D.copyFile (modul "files/license") (other "files/license") + TIO.writeFile (other "module.dhall") (T.replace "./schema/package.dhall" "../demo/schema/package.dhall" (T.replace "name=\"demo\"" "name=\"other\"" (body "managed" ""))) + _ <- success binary root ["run", "other", "--force"] + candidate modul "seed" + before <- BS.readFile (root ".seihou/manifest.json") + forM_ [[], ["--include-shared-owners"]] $ \flags -> do + (code, _, _) <- invoke binary root (["update", "demo", "--json"] <> flags) + code `shouldBe` ExitFailure 1 + BS.readFile (root ".seihou/manifest.json") `shouldReturn` before + TIO.readFile (root "nested/start.txt") `shouldReturn` "starter\n" diff --git a/test/Seihou/CLI/StatusSpec.hs b/test/Seihou/CLI/StatusSpec.hs --- a/test/Seihou/CLI/StatusSpec.hs +++ b/test/Seihou/CLI/StatusSpec.hs @@ -2,6 +2,7 @@ import Control.Lens (to, (&), (.~)) import Data.Map.Strict qualified as Map +import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError) @@ -14,6 +15,7 @@ formatArtifactChecks, formatStatus, formatStatusWith, + seedSection, ) import Seihou.CLI.VersionCompare ( OutdatedEntry (..), @@ -40,6 +42,7 @@ RecipeName (..), emptyParentVars, ) +import Seihou.Core.Types qualified as Types import Seihou.Core.Version qualified import Seihou.Manifest.Types (emptyManifest) import Test.Hspec @@ -86,6 +89,7 @@ context = Nothing, instances = map mkInstance modules, commandReceipts = Map.empty, + checkoutCommands = [], appliedAt = fixedTime } where @@ -164,6 +168,12 @@ spec :: Spec spec = describe "formatStatus" $ do + describe "seed receipt summary" $ do + it "counts settlements in one line without listing paths" $ do + let receipt = Types.SeedRecord "supplier" (Types.LegacySeedOwners Set.empty) Types.SeedCreated fixedTime + manifest = emptyManifest fixedTime & #seeds .~ Map.fromList [("deleted.txt", receipt), ("edited.txt", receipt)] + seedSection manifest `shouldBe` ["", "Seed files: 2 (created once; owned by the project, not tracked)"] + seedSection (emptyManifest fixedTime) `shouldBe` [] describe "blueprint provenance" $ do it "renders a populated blueprint with version, two baselines, and prompt" $ do let manifest = diff --git a/test/Seihou/CLI/UpdateE2ESpec.hs b/test/Seihou/CLI/UpdateE2ESpec.hs --- a/test/Seihou/CLI/UpdateE2ESpec.hs +++ b/test/Seihou/CLI/UpdateE2ESpec.hs @@ -211,7 +211,7 @@ expectSuccess "targeted update" exitCode stdoutText stderrText stdoutText `shouldSatisfy` T.isInfixOf "\"outcome\":\"applied\"" manifestText <- TIO.readFile (fixture ^. #manifestPath) - manifestText `shouldSatisfy` T.isInfixOf "\"version\":9" + manifestText `shouldSatisfy` T.isInfixOf "\"version\":11" manifestText `shouldSatisfy` T.isInfixOf "\"sharedWriteMode\":\"additive-only\"" -- Recording an answer must not touch a single byte of the project. TIO.readFile (fixture ^. #gitignorePath) `shouldReturn` beforeGitignore @@ -271,7 +271,7 @@ case decoded of Left err -> expectationFailure err Right manifest -> do - (manifest ^. #version) `shouldBe` ManifestSchemaVersion 9 + (manifest ^. #version) `shouldBe` ManifestSchemaVersion 11 case Map.lookup ".gitignore" (manifest ^. #files) of Nothing -> expectationFailure "the manifest lost .gitignore" Just record -> do diff --git a/test/Seihou/CLI/UpdateSpec.hs b/test/Seihou/CLI/UpdateSpec.hs --- a/test/Seihou/CLI/UpdateSpec.hs +++ b/test/Seihou/CLI/UpdateSpec.hs @@ -583,7 +583,7 @@ withSystemTempDirectory "seihou-update-schema-5" $ \root -> do fixture <- prepareSharedPathFixture CoOwnerAppends root manifestText <- TIO.readFile (fixture ^. #manifestPath) - TIO.writeFile (fixture ^. #manifestPath) (T.replace "\"version\":9" "\"version\":5" manifestText) + TIO.writeFile (fixture ^. #manifestPath) (T.replace "\"version\":11" "\"version\":5" manifestText) withSavedEnv "XDG_CONFIG_HOME" (Just (fixture ^. #xdgHome)) $ withCurrentDirectory (fixture ^. #projectRoot) $ do forM_ [NamedUpdateTargets ["alpha"], AllRecordedApplications] $ \selection -> do @@ -725,7 +725,7 @@ xdgHome = root "xdg" installedModule = xdgHome "seihou" "installed" "demo" unchangedCommand = "printf should-not-run >> command.log" - commandOperation = RunCommandOp unchangedCommand Nothing "demo" 0 + commandOperation = RunCommandOp unchangedCommand Nothing "demo" 0 ApplicationCommand commandFingerprint = fromMaybe (error "test fixture command fingerprint") (fingerprintCommand commandOperation) commandReceipt = CommandReceipt commandFingerprint "demo" unchangedCommand Nothing testTime baselineContent = "hello accepted\nkeep\nv1\n" @@ -1037,6 +1037,7 @@ instanceStateFrom "one" (remoteOrigin "one") ], commandReceipts = Map.empty, + checkoutCommands = [], appliedAt = testTime } base = emptyManifest testTime @@ -1139,6 +1140,7 @@ context = Nothing, instances, commandReceipts = Map.empty, + checkoutCommands = [], appliedAt = testTime } where diff --git a/test/Seihou/CLI/UpgradeDiagnosisSpec.hs b/test/Seihou/CLI/UpgradeDiagnosisSpec.hs --- a/test/Seihou/CLI/UpgradeDiagnosisSpec.hs +++ b/test/Seihou/CLI/UpgradeDiagnosisSpec.hs @@ -43,7 +43,7 @@ withFixture CoOwnerAppendsPredatingEvidence noDamage $ \_ _ diagnose -> do checks <- readiness <$> diagnose "alpha" statusOf "manifest-schema-current" checks `shouldBe` NeedsAttention - detailOf "manifest-schema-current" checks `shouldSatisfy` T.isInfixOf "schema 6 is older than 9" + detailOf "manifest-schema-current" checks `shouldSatisfy` T.isInfixOf "schema 6 is older than 11" statusOf "shared-evidence-known" checks `shouldBe` NeedsAttention detailOf "shared-evidence-known" checks `shouldBe` ".gitignore is shared with beta and its write mode is unknown" statusOf "update-plans-cleanly" checks `shouldBe` Ready @@ -59,7 +59,7 @@ ((^. #errorCode) <$> diagnosis ^. #updateDryRun) `shouldBe` ProbeOk (Just "shared_write_evidence_unavailable") it "reports a schema-5 manifest as needing seihou manifest upgrade" $ - withFixture CoOwnerAppends (withManifestText (T.replace "\"version\":9" "\"version\":5")) $ \_ _ diagnose -> do + withFixture CoOwnerAppends (withManifestText (T.replace "\"version\":11" "\"version\":5")) $ \_ _ diagnose -> do diagnosis <- diagnose "alpha" let checks = readiness diagnosis statusOf "manifest-readable" checks `shouldBe` NeedsAttention @@ -154,7 +154,7 @@ [ ("healthy" :: Text, CoOwnerAppends, const (pure ())), ("schema 6", CoOwnerAppendsPredatingEvidence, const (pure ())), ("evidence unavailable", CoOwnerAppendsPredatingEvidence, evidenceUnavailable), - ("schema 5", CoOwnerAppends, withManifestText (T.replace "\"version\":9" "\"version\":5")), + ("schema 5", CoOwnerAppends, withManifestText (T.replace "\"version\":11" "\"version\":5")), ("not json", CoOwnerAppends, withManifestText (const "{not json")), ("local origin", CoOwnerAppends, localBetaOrigin), ("pending transaction", CoOwnerAppends, pendingTransaction)