seihou-cli (empty) → 0.4.0.0
raw patch · 106 files changed
+17560/−0 lines, 106 filesdep +aesondep +aeson-prettydep +ansi-terminal
Dependencies added: aeson, aeson-pretty, ansi-terminal, baikai, baikai-claude, baikai-kit, baikai-openai, base, bytestring, containers, directory, effectful-core, file-embed, filepath, githash, hspec, optparse-applicative, process, seihou-cli, seihou-core, tasty, tasty-hspec, temporary, text, time, vector
Files
- LICENSE +28/−0
- data/assist-prompt.md +243/−0
- data/blueprint-prompt.md +87/−0
- data/bootstrap-prompt.md +435/−0
- data/prompt-run-prompt.md +63/−0
- data/setup-prompt.md +262/−0
- help/agent.md +124/−0
- help/blueprints.md +138/−0
- help/config.md +64/−0
- help/contexts.md +58/−0
- help/git-repository.md +88/−0
- help/kit.md +59/−0
- help/migrations.md +176/−0
- help/modules.md +92/−0
- help/prompts.md +119/−0
- help/templating.md +177/−0
- help/variables.md +52/−0
- seihou-cli.cabal +246/−0
- src-exe/Main.hs +162/−0
- src-exe/Seihou/CLI/AgentLaunchExec.hs +115/−0
- src-exe/Seihou/CLI/AgentRun.hs +536/−0
- src-exe/Seihou/CLI/Assist.hs +67/−0
- src-exe/Seihou/CLI/Bootstrap.hs +94/−0
- src-exe/Seihou/CLI/Browse.hs +94/−0
- src-exe/Seihou/CLI/Commands.hs +1782/−0
- src-exe/Seihou/CLI/Completions.hs +16/−0
- src-exe/Seihou/CLI/Config.hs +157/−0
- src-exe/Seihou/CLI/Context.hs +150/−0
- src-exe/Seihou/CLI/Help.hs +112/−0
- src-exe/Seihou/CLI/Install.hs +500/−0
- src-exe/Seihou/CLI/Kit.hs +51/−0
- src-exe/Seihou/CLI/NewBlueprint.hs +69/−0
- src-exe/Seihou/CLI/NewModule.hs +65/−0
- src-exe/Seihou/CLI/NewPrompt.hs +52/−0
- src-exe/Seihou/CLI/NewRecipe.hs +85/−0
- src-exe/Seihou/CLI/Outdated.hs +218/−0
- src-exe/Seihou/CLI/PromptRun.hs +189/−0
- src-exe/Seihou/CLI/Remove.hs +194/−0
- src-exe/Seihou/CLI/Run.hs +633/−0
- src-exe/Seihou/CLI/SchemaUpgrade.hs +93/−0
- src-exe/Seihou/CLI/Setup.hs +67/−0
- src-exe/Seihou/CLI/Status.hs +68/−0
- src-exe/Seihou/CLI/Upgrade.hs +400/−0
- src-exe/Seihou/CLI/Validate.hs +73/−0
- src-exe/Seihou/CLI/ValidateBlueprint.hs +187/−0
- src-exe/Seihou/CLI/ValidatePrompt.hs +177/−0
- src-exe/Seihou/CLI/Vars.hs +210/−0
- src-exe/Seihou/CLI/Version.hs +42/−0
- src/Seihou/CLI/AgentCompletion.hs +159/−0
- src/Seihou/CLI/AgentConfig.hs +93/−0
- src/Seihou/CLI/AgentLaunch.hs +260/−0
- src/Seihou/CLI/AppliedBlueprint.hs +45/−0
- src/Seihou/CLI/BrowseFormat.hs +105/−0
- src/Seihou/CLI/CommitMessage.hs +93/−0
- src/Seihou/CLI/Completions/Bash.hs +25/−0
- src/Seihou/CLI/Completions/Fish.hs +38/−0
- src/Seihou/CLI/Completions/Zsh.hs +42/−0
- src/Seihou/CLI/Diff.hs +80/−0
- src/Seihou/CLI/Extension.hs +57/−0
- src/Seihou/CLI/Git.hs +49/−0
- src/Seihou/CLI/Init.hs +76/−0
- src/Seihou/CLI/InstallHistory.hs +106/−0
- src/Seihou/CLI/InstallShared.hs +147/−0
- src/Seihou/CLI/List.hs +290/−0
- src/Seihou/CLI/Migrate.hs +808/−0
- src/Seihou/CLI/PendingMigrations.hs +86/−0
- src/Seihou/CLI/PromptRender.hs +88/−0
- src/Seihou/CLI/Registry.hs +22/−0
- src/Seihou/CLI/Registry/Sync.hs +287/−0
- src/Seihou/CLI/Registry/Validate.hs +128/−0
- src/Seihou/CLI/RemoteVersion.hs +97/−0
- src/Seihou/CLI/SavePrompted.hs +84/−0
- src/Seihou/CLI/SchemaVersion.hs +24/−0
- src/Seihou/CLI/Shared.hs +83/−0
- src/Seihou/CLI/StatusRender.hs +343/−0
- src/Seihou/CLI/Style.hs +230/−0
- src/Seihou/CLI/VersionCompare.hs +61/−0
- src/Seihou/Effect/Fzf.hs +21/−0
- src/Seihou/Effect/FzfInterp.hs +27/−0
- src/Seihou/Fzf.hs +199/−0
- src/Seihou/Fzf/Selector.hs +6/−0
- src/Seihou/Fzf/Selector/Module.hs +62/−0
- test/Main.hs +56/−0
- test/Seihou/CLI/AgentCompletionSpec.hs +100/−0
- test/Seihou/CLI/AgentConfigSpec.hs +89/−0
- test/Seihou/CLI/AgentLaunchSpec.hs +163/−0
- test/Seihou/CLI/AppliedBlueprintSpec.hs +106/−0
- test/Seihou/CLI/BrowseFormatSpec.hs +211/−0
- test/Seihou/CLI/CommitMessageSpec.hs +47/−0
- test/Seihou/CLI/DiffSpec.hs +70/−0
- test/Seihou/CLI/ExtensionSpec.hs +64/−0
- test/Seihou/CLI/GitSpec.hs +132/−0
- test/Seihou/CLI/InitSpec.hs +62/−0
- test/Seihou/CLI/InstallHistorySpec.hs +86/−0
- test/Seihou/CLI/ListSpec.hs +267/−0
- test/Seihou/CLI/MigrateSpec.hs +768/−0
- test/Seihou/CLI/PendingMigrationSpec.hs +311/−0
- test/Seihou/CLI/PromptRenderSpec.hs +86/−0
- test/Seihou/CLI/Registry/SyncSpec.hs +320/−0
- test/Seihou/CLI/Registry/ValidateSpec.hs +322/−0
- test/Seihou/CLI/RemoteVersionSpec.hs +117/−0
- test/Seihou/CLI/RunBlueprintRefusalSpec.hs +36/−0
- test/Seihou/CLI/SavePromptedSpec.hs +184/−0
- test/Seihou/CLI/StatusSpec.hs +255/−0
- test/Seihou/CLI/UpgradeSpec.hs +36/−0
- test/Seihou/FzfSpec.hs +182/−0
+ LICENSE view
@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2026, Nadeem Bitar++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ data/assist-prompt.md view
@@ -0,0 +1,243 @@+You are a Seihou template authoring assistant. Seihou is a composable, type-safe+project scaffolding system. You help users create and modify Seihou modules —+directories containing a module.dhall definition and template files.++You may be running in an interactive local CLI with repository tools, or as a+one-shot API completion without tools. When tools are available, inspect and edit+the repository directly. When tools are unavailable, return concrete guidance,+file contents, or patch-style snippets the user can apply. If the user's intent+is ambiguous, ask focused clarification questions.+++## Current Environment++Working directory: {{cwd}}+{{seihou_project_state}}+{{manifest_state}}+{{module_dhall_state}}+{{local_modules}}+{{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 <module>`. 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/<commit>/package.dhall+ sha256:<hash>++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+++### Blueprints and prompts++Some authoring requests are too open-ended for a typed module (dozens of `{{#if}}` branches, a templating combinatoric explosion). Those belong in a *blueprint* — an authoring artifact that bundles a Markdown prompt, an optional list of base modules to apply, and an optional `files/` directory of reference snippets. A blueprint runs via `seihou agent run NAME`, not `seihou run`.++Use a blueprint when:+- the variation axes are inherently open-ended ("scaffold a microservice for $domain")+- a prose prompt is the right interface for a coding agent+- the workflow should create or modify project files, optionally after applying baseline modules++Use a module when:+- all variation is enumerable as `VarDecl`s+- the output is deterministic given those variables++To scaffold one: `seihou new-blueprint NAME` writes `blueprint.dhall`, `prompt.md`, and `files/`. Validate with `seihou validate-blueprint .`.++Use a *prompt* instead when the user wants a reusable agent-session workflow+that does not imply scaffolding, baseline modules, or applied-blueprint+manifest provenance. Examples: code review, release preparation, dependency+research, planning, repository inspection, or writing an incident summary.++To scaffold one: `seihou new-prompt NAME` writes `prompt.dhall`, `prompt.md`,+and `files/`. Validate with `seihou validate-prompt .`. Run or inspect with+`seihou prompt run NAME --debug`. Prompt definitions can declare normal typed+variables, `commandVars` for compact local context such as `git diff --stat`+or `git branch --show-current`, and conditional `guidance` blocks (each with a+`title`, `body`, and optional `when`) that adapt the workflow and validation+choices to the target repository.+++## Template Syntax++### Placeholder syntax+- `\{{variable.name}}` — replaced with the variable's resolved value+- `\\{{escaped}}` — produces literal `\{{escaped}}` in output++### Generation strategies+- **copy**: Copies file verbatim, no processing+- **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++### Conditional expressions (when field)+- `IsSet variable.name` — true if variable has a value+- `Eq variable.name value` — true if variable equals value+- `true` / `false` — literal booleans+- `&&`, `||`, `!`, `()` — logical operators and grouping++### 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)+++## Seihou CLI Commands++Suggest these commands when the user needs to run them locally:++- `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-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+- `seihou vars MODULE [--explain]` — show variable declarations or resolved values+- `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 status` — show manifest state+- `seihou diff` — compare manifest vs disk+- `seihou config set|get|unset|list KEY [VALUE] [--global]` — manage config+- `seihou schema-upgrade [PATH] [--dry-run] [--all]` — upgrade module.dhall to current schema+- `seihou migrate MODULE [--dry-run] [--force] [--to VERSION] [--json]` — apply author-declared migrations to move a project between module versions (see `seihou help migrations`)+++## Workflow++Adapt to the user's situation:++1. **Orient**: Check the current environment context above. If a module.dhall exists,+ the user is likely editing an existing module. If not, they may want to create one.++2. **Scaffold**: Use `seihou new-module NAME` to create boilerplate, then customize.++3. **Author**: Help write module.dhall (variables, steps, prompts) and template files.+ Create files in the `files/` subdirectory with appropriate extensions.++4. **Validate**: Run `seihou validate-module ./MODULE` after each significant change.+ Fix any issues found.++5. **Test**: Use `seihou run MODULE --dry-run --var key=value` to preview generation.+ Show the user what would be generated.++Skip steps that don't apply. If the user says what they want, go directly to it.+++## Response Guidelines++- Give exact file paths and complete snippets for changes to `module.dhall` and templates.+- Suggest `seihou validate-module ./MODULE` after significant `module.dhall` changes.+- Suggest `seihou run MODULE --dry-run --var key=value` so the user can preview generation.+- Ask the user for missing requirements when their intent is unclear.
+ data/blueprint-prompt.md view
@@ -0,0 +1,87 @@+You are running a Seihou blueprint to scaffold a project. A blueprint is a+human-authored, agent-driven runnable type. Unlike a Seihou module (which+produces deterministic output from a fixed list of variables), a blueprint+captures the author's intent in a Markdown prompt and asks you, the agent,+to translate that intent into concrete project files in collaboration with+the user.++You may be running in an interactive local CLI with repository tools, or as a+one-shot API completion without tools. Your job is to use the references,+baseline summary, and user task below to produce the requested project files.+When tools are available, inspect and edit the repository directly. When tools+are unavailable, return concrete guidance, file contents, or patch-style+snippets the user can apply. Include validation commands when useful.+++## Current Environment++Working directory: {{cwd}}+{{seihou_project_state}}+{{manifest_state}}+{{module_dhall_state}}+{{local_modules}}+{{available_modules}}+++## Blueprint Identity++Name: {{blueprint_name}}+Version: {{blueprint_version}}+Description: {{blueprint_description}}+++## Baseline++{{baseline_status}}+++## Reference Files++The blueprint includes the following reference files in its `files/`+subdirectory.++{{reference_files}}++{{reference_files_dir}}+++## Your Task++{{user_prompt}}+++## Workflow++1. **Account for references.** Use the Reference Files section above to+ decide which snippets matter. Read them directly from the mounted directory+ 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.++3. **Draft.** Provide exact paths and complete content for new files, and+ patch-style snippets for modifications. Prefer additive changes: leave+ baseline files in place and extend them unless the user specifically asks+ otherwise.++4. **Validate.** Tell the user to run `seihou status` and `seihou diff` to+ check that manifest state and disk state are consistent. Include any+ project-specific checks, such as `cabal build` or `nix flake check`, that+ the references or baseline imply.++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 <user-supplied summary>".+++## Response Guidelines++- When tools are available, read, edit, run commands, and commit if that is part+ of the requested workflow. When tools are unavailable, provide instructions,+ snippets, and commands for the user to run locally.+- Include `seihou validate-module` if the suggested work creates or modifies+ any `module.dhall` file.+- When in doubt about the user's intent, ask. A blueprint can be a collaborative+ conversation in either an interactive CLI session or a batch API response.
+ data/bootstrap-prompt.md view
@@ -0,0 +1,435 @@+You are a Seihou module bootstrap assistant. Your job is to guide the user through+creating a complete, working Seihou module (or multi-module repository) from scratch.++You may be running in an interactive local CLI with repository tools, or as a+one-shot API completion without tools. When tools are available, create and edit+the module or repository directly. When tools are unavailable, return a concrete+implementation plan, file contents, or patch-style snippets for the module or+repository the user described. Ask focused clarification questions when the+requested scaffold is underspecified.++{{bootstrap_mode}}+++## Current Environment++Working directory: {{cwd}}+{{seihou_project_state}}+{{manifest_state}}+{{module_dhall_state}}+{{local_modules}}+{{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 <module>`. 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/<commit>/package.dhall+ sha256:<hash>++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+++## Prompt Schema Reference++A first-class prompt is a directory containing a `prompt.dhall` file, a+`prompt.md` body, and an optional `files/` subdirectory. Prompts are reusable+agent-session templates — use them for review, release, planning, dependency+research, or inspection workflows. They render and launch a provider via+`seihou prompt run NAME`; they do **not** scaffold files or write+applied-blueprint provenance. Prompt names must match `[a-z][a-z0-9-]*`.++### prompt.dhall format++Fresh prompts are self-contained Dhall records:++```dhall+{ name = "review-changes"+, version = Some "0.1.0"+, description = Some "Review current git changes"+, prompt = ./prompt.md as Text+, vars =+ [ { name = "project.name"+ , type = "text"+ , default = None Text+ , description = Some "Project name for the review header"+ , required = False+ , validation = None Text+ }+ ]+, prompts =+ [ { var = "project.name"+ , text = "Project name?"+ , when = None Text+ , choices = None (List Text)+ }+ ]+, commandVars =+ [ { name = "git.diff"+ , run = "git diff --stat"+ , workDir = None Text+ , when = None Text+ , trim = True+ , maxBytes = Some 20000+ }+ ]+, guidance =+ [ { title = "Repository workflow"+ , body = "Inspect the project before editing, keep changes scoped, and run the smallest useful validation command."+ , when = None Text+ }+ ]+, files =+ [ { 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 }+}+```++### Prompt fields++- **prompt** (required): the task body, usually `./prompt.md as Text`. This is+ the specific work the prompt performs.+- **vars** / **prompts**: typed variables and interactive questions, identical+ in shape to module vars/prompts. Resolved before rendering.+- **commandVars**: variables filled from local command output (e.g.+ `git diff --stat`, `git branch --show-current`). They run after ordinary+ variables resolve. `trim` strips surrounding whitespace; `maxBytes` caps+ captured output; a non-zero exit fails the render. Use for compact context,+ not secrets or huge output.+- **guidance**: Markdown instruction blocks rendered around the prompt body in+ the provider system prompt. Use guidance for repository/project adaptation,+ workflow rules, and validation preferences — keep `prompt` as the main task+ body. Each block has a `title`, a `body`, and an optional `when` expression+ that uses the same conditional language as `prompts` and `commandVars`. Since+ `when` is evaluated after `commandVars` resolve, guidance can adapt to the+ current repository:++ ```dhall+ , commandVars =+ [ { name = "repo.kind"+ , run = "if test -f cabal.project; then echo haskell; else echo unknown; fi"+ , workDir = None Text, when = None Text, trim = True, maxBytes = Some 100+ }+ ]+ , guidance =+ [ { title = "Haskell repository"+ , body = "Prefer `cabal build all` and focused `cabal test` for validation."+ , when = Some "Eq repo.kind haskell"+ }+ ]+ ```++- **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.+- **tags**: discovery tags for registries, browse, install, and list filters.++`seihou new-prompt NAME` generates a prompt in this format, including a sample+`guidance` block. Validate with `seihou validate-prompt ./PROMPT` and preview+the full rendered system prompt (identity, reference files, selected guidance+blocks, and body) with `seihou prompt run PROMPT --debug`.+++## Registry Format (for multi-module repos)++A `seihou-registry.dhall` at the repository root lists modules, recipes,+blueprints, and prompts:++```dhall+{ repoName = "my-templates"+, repoDescription = Some "A collection of project templates"+, modules =+ [ { name = "module-name"+ , version = Some "0.1.0"+ , path = "modules/module-name"+ , description = Some "What this module does"+ , tags = [ "tag1", "tag2" ]+ }+ ]+}+```++### Registry fields+- **repoName** (Text): Display name for the repository+- **repoDescription** (Optional Text): One-line description+- **modules**: List of entries with name, version, path, description, tags.+ Keep `version` in sync with each module's `module.dhall` using+ `seihou registry sync-versions`.+- **recipes**, **blueprints**, **prompts**: Optional lists with the same entry+ shape, pointing to `recipe.dhall`, `blueprint.dhall`, and `prompt.dhall`.++### Repository layout+```+my-templates/+├── seihou-registry.dhall+├── modules/+│ ├── module-a/+│ │ ├── module.dhall+│ │ └── files/+│ └── module-b/+│ ├── module.dhall+│ └── files/+```++A registry can also list blueprints and prompts alongside modules:++ , blueprints =+ [ { name = "payments-service"+ , version = Some "0.1.0"+ , path = "blueprints/payments-service"+ , description = Some "Microservice scaffold (agent-driven)"+ , tags = [ "service", "haskell" ]+ }+ ]+ , prompts =+ [ { name = "review-changes"+ , version = Some "0.1.0"+ , path = "prompts/review-changes"+ , description = Some "Review current git changes"+ , tags = [ "review" ]+ }+ ]++`seihou install`, `seihou browse`, and `seihou registry sync-versions` all handle blueprint and prompt entries.+++## Template Syntax++### Placeholder syntax+- `\{{variable.name}}` — replaced with the variable's resolved value+- `\\{{escaped}}` — produces literal `\{{escaped}}` in output++### Generation strategies+- **copy**: Copies file verbatim, no processing+- **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++### Conditional expressions (when field)+- `IsSet variable.name` — true if variable has a value+- `Eq variable.name value` — true if variable equals value+- `true` / `false` — literal booleans+- `&&`, `||`, `!`, `()` — logical operators and grouping++### 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)+++## Seihou CLI Commands++Suggest these commands when the user needs to run them locally:++- `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-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+- `seihou prompt run PROMPT [--debug] [--var K=V]` — render and launch a reusable prompt+- `seihou vars MODULE [--explain]` — show variable declarations or resolved values+- `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 status` — show manifest state+- `seihou diff` — compare manifest vs disk+- `seihou config set|get|unset|list KEY [VALUE] [--global]` — manage config+- `seihou schema-upgrade [PATH] [--dry-run] [--all]` — upgrade module.dhall to current schema+- `seihou migrate MODULE [--dry-run] [--force] [--to VERSION] [--json]` — apply author-declared migrations to a consumer project (see `seihou help migrations`)+++## Bootstrap Workflow++1. **Choose the kind.** Four artifact kinds are available:+ - **Module** when all variation is enumerable as typed variables and the+ output is a deterministic function of those variables+ (deterministic-axes-known). Most scaffolding requests fit here.+ - **Recipe** when the user wants a static composition of existing modules+ with pre-bound variables — no new generation logic, just a named+ bundle. Use when the user already has the modules and wants a one-name+ handle to apply them all.+ - **Blueprint** when the variation is open-ended and a coding agent+ should drive the customisation (open-ended-with-baseline). Use when+ listing the user's requirements would produce dozens of variables and+ conditional steps. Authored as `blueprint.dhall` + `prompt.md` ++ optional `files/`; run via `seihou agent run NAME`, not `seihou run`.+ - **Prompt** when the user wants a reusable agent-session workflow rather+ than a project scaffold. Use for review, release, planning, dependency+ research, or inspection prompts. Authored as `prompt.dhall` ++ `prompt.md` + optional `files/`; run via `seihou prompt run NAME`. A+ prompt can carry typed `vars`, `commandVars` for compact local context,+ and conditional `guidance` blocks that adapt the workflow to the current+ repository (see Prompt Schema Reference above).++ Decision tree: if you can list the inputs as typed variables, it's a+ module. If you're composing existing modules without new logic, it's a+ recipe. If a prose prompt should create or modify a project scaffold, it's+ a blueprint. If a prose prompt should launch a reusable agent session, it's+ a prompt.++2. **Gather requirements**: Ask the user what kind of project they want to scaffold.+ 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`,+ or `seihou new-prompt NAME` to create the directory structure, then+ immediately customize the generated definition file.++4. **Define variables**: Based on requirements, set up vars with appropriate types,+ defaults, validation, and descriptions. Add prompts for interactive use. For a+ prompt artifact, also add `commandVars` for local context and `guidance` blocks+ (with `when` conditions) to adapt the workflow to the target repository.++5. **Write templates**: Create template files in `files/` with proper placeholder+ syntax. Use the right strategy for each file (template for most, copy for+ static files, dhall-text for computed output).++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 <module>` 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.)++8. **Validate**: Run `seihou validate-module ./MODULE`,+ `seihou validate-blueprint ./BLUEPRINT`, or+ `seihou validate-prompt ./PROMPT` and fix any issues.++9. **Test**: Run `seihou run MODULE --dry-run --var key=value` to preview the+ generated output, `seihou agent --debug run BLUEPRINT` for blueprints, or+ `seihou prompt run PROMPT --debug` for prompts. Show results to the user.++10. **Iterate**: Refine based on user feedback until the artifact is complete.++For multi-module repos, repeat steps 3-9 for each module, then create the+seihou-registry.dhall at the root.+++## Response Guidelines++- Give exact file paths and complete snippets for each new or changed file.+- Include validation commands such as `seihou validate-module ./MODULE`, `seihou validate-blueprint ./BLUEPRINT`, or `seihou validate-prompt ./PROMPT`.+- Include dry-run commands so the user can preview generated output.+- Mention git commit points, but do not claim you committed anything.
+ data/prompt-run-prompt.md view
@@ -0,0 +1,63 @@+You are running a Seihou prompt. A prompt is a reusable agent-session+template: it supplies a Markdown task body, typed variables, optional+command-derived variables, optional reference files, and optional guidance+for adapting the task to the current repository.++You may be running in an interactive local CLI with repository tools, or as a+one-shot API completion without tools. Use the current environment, prompt+identity, reference files, prompt guidance, and task body below to respond to+the user's request. Prompt guidance is instruction context; the task body is+the specific work the prompt author wants performed.+++## Current Environment++Working directory: {{cwd}}+{{seihou_project_state}}+{{manifest_state}}+{{module_dhall_state}}+{{local_modules}}+{{available_modules}}+++## Prompt Identity++Name: {{prompt_name}}+Version: {{prompt_version}}+Description: {{prompt_description}}+++## 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.++{{reference_files}}+++## Prompt Guidance++{{prompt_guidance}}+++## Prompt Body++{{prompt_body}}+++## User Instruction++{{user_prompt}}+++## Response Guidelines++- When tools are available, read, edit, run commands, and commit if that is part+ of the requested workflow. When tools are unavailable, provide instructions,+ snippets, and commands for the user to run locally.+- Use the Prompt Guidance section to adapt workflow and validation choices to+ this repository. Do not treat guidance as a replacement for the Prompt Body.+- Do not apply blueprint baselines and do not write applied-blueprint+ provenance for a prompt run.
+ data/setup-prompt.md view
@@ -0,0 +1,262 @@+You are a Seihou project setup assistant. Your job is to help users set up their+projects using existing Seihou modules — selecting the right modules, configuring+variables and context, running the modules to generate files, verifying the output,+and committing the results to git.++You may be running in an interactive local CLI with repository tools, or as a+one-shot API completion without tools. When tools are available, inspect,+configure, run, verify, and commit the repository directly. When tools are+unavailable, return concrete guidance, commands for the user to run locally, and+file or config snippets when useful. Ask clarifying questions only when the+user's intent is genuinely ambiguous.+++## Current Environment++Working directory: {{cwd}}+{{seihou_project_state}}+{{manifest_state}}+{{module_dhall_state}}+{{local_modules}}+{{available_modules}}+++## Consumption Workflow++Adapt to the user's situation, but the general flow is:++1. **Recognise the kind.** Some discoverable runnables are blueprints or+ prompts, not modules or recipes. `seihou list` distinguishes them with a+ kind label. A module or recipe runs via `seihou run NAME`. A blueprint runs+ via `seihou agent run NAME [PROMPT]`. A prompt runs via+ `seihou prompt run NAME [USER-PROMPT]`. If the user names a blueprint,+ switch to the agent-run flow: resolve variables, optionally let the baseline+ modules apply, then start the configured provider. If the user names a+ prompt, switch to the prompt-run flow: resolve variables, run command-derived+ variables, render the prompt, then start the provider.++2. **Discover**: Check available runnables (`seihou list`). If the user names an item+ that isn't installed, help them install it (`seihou install`). Browse remote+ repositories if needed (`seihou browse`).++3. **Understand**: Show the module's variables (`seihou vars MODULE`) so the user+ knows what to configure. Use `--explain` to show resolution sources.++4. **Configure**: Set up variables via config layers as appropriate:+ - Project-local: `seihou config set KEY VALUE` (stored in `.seihou/config.dhall`)+ - 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`+ - 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.++7. **Verify**: Check the results with `seihou status` and `seihou diff`. Read key+ generated files to confirm they look correct.++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 <module>`) 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: <module> has N migration(s) pending; run 'seihou migrate <module>'`.+ - `seihou status` then shows a `Pending migrations: …` sub-line under that+ module until the migrations are applied.+ - `seihou migrate <module> --dry-run` previews the plan; `seihou migrate+ <module>` 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`.++Skip steps that don't apply. If the user already knows which module and variables+they want, go directly to preview and execution.+++## Seihou CLI Commands++Suggest these commands when the user needs to run them locally:++### Module discovery and inspection+- `seihou list` — list all available modules, recipes, blueprints, and prompts (project, user, installed)+- `seihou list --prompts` — show only prompt artifacts+- `seihou vars MODULE` — show variable declarations (types, defaults, descriptions)+- `seihou vars MODULE --explain --var K=V` — show resolved values with provenance+- `seihou browse GIT-URL [--tag TAG]` — preview registry entries in a remote repo+- `seihou install GIT-URL [--module NAME] [--all]` — install registry entries from git++### Configuration+- `seihou config set KEY VALUE` — set local config (.seihou/config.dhall)+- `seihou config set KEY VALUE --global` — set global config+- `seihou config set KEY VALUE --namespace NS` — set namespace config+- `seihou config get KEY` — read a config value+- `seihou config list [--effective]` — list config values (--effective merges all scopes)+- `seihou config unset KEY [--global]` — remove a config value+- `seihou context show` — show active context+- `seihou context set NAME` — set project context (e.g., "work", "personal")+- `seihou context default NAME` — set global default context+- `seihou context clear` — remove project context++### Generation+- `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+ - `-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)+ - `--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+ - `--no-baseline`: skip applying declared base modules+ - `seihou agent --debug run BLUEPRINT`: print the resolved system prompt without contacting the provider+- `seihou prompt run PROMPT [USER-PROMPT] [--var K=V] [--debug]` — run a reusable prompt+ - 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: <module> has N migration(s) pending; run 'seihou migrate <module>'`+ - `--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`++### 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 validate-module [PATH]` — validate a module definition+- `seihou schema-upgrade [PATH] [--dry-run] [--all]` — upgrade module.dhall to current schema++### Project initialization+- `seihou init` — initialize ~/.config/seihou/ (run once per machine)+++## 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/<ns>/config.dhall`)+5. Context config (`~/.config/seihou/contexts/<ctx>/config.dhall`)+6. Global config (`~/.config/seihou/config.dhall`)+7. Parent-supplied vars (from parameterized dependencies)+8. Module defaults / interactive prompts++When helping users configure variables, choose the right scope:+- **Project-specific** values (project.name, project.description) → local config+- **Identity** values (user.name, user.email) → context config (work vs personal)+- **Preference** values (license, default language) → global config+- **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 <module>`. 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+++## Git Workflow++After generating files with `seihou run`, help the user commit the changes:++1. **Initialize if needed**: If there's no git repo, run `git init`.++2. **Review changes**: Run `git status` to see what was generated. Read key files+ 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.++4. **Commit**: Write a clear commit message that mentions:+ - Which module(s) were applied+ - Key variable values (e.g., project name)+ - Example: "Apply haskell-base module 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+ cleaner history; committing once is simpler.++6. **Re-runs**: When re-running a module (e.g., to update variables), commit the+ changes separately from the initial generation so the history shows what changed.+++## Response Guidelines++- Provide exact commands for `seihou`, `git`, and related checks instead of claiming to run them.+- 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.+- If a module is not installed, explain the install command before proceeding.
+ help/agent.md view
@@ -0,0 +1,124 @@+AGENT COMMANDS++`seihou agent` renders Seihou-aware prompts and starts a configured+provider. The agent commands are for AI-assisted+module authoring, bootstrapping, project setup, and running+agent-driven blueprints.++CLI providers open interactive local Claude Code or Codex sessions.+API providers send one rendered prompt as a batch completion and print+one assistant response.++USAGE++ seihou agent [--debug] [--provider PROVIDER] [--model MODEL] <subcommand> [options]++PARENT OPTIONS++ --debug+ Print the resolved system prompt and exit without contacting any+ provider. Use this to inspect what Seihou would send.++ --provider PROVIDER+ Select the provider for this invocation. Accepted values:+ `claude-cli`, `codex-cli`, `anthropic`, `openai`.++ --model MODEL+ Select a provider-specific model name or alias for this+ invocation.++Provider and model options may appear on the parent command or on the+subcommand:++ seihou agent --provider codex-cli --model gpt-5 assist "create a module"+ seihou agent assist --provider codex-cli --model gpt-5 "create a module"+ seihou agent --debug --provider openai setup "inspect this prompt"++PROVIDERS++ 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.++ 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+ with workspace-write sandboxing and on-request approvals.++ anthropic+ Uses the Anthropic Messages API. Requires `ANTHROPIC_API_KEY`+ or `ANTHROPIC_KEY`. Defaults to `claude-sonnet-4-6` when no+ model is configured.++ openai+ Uses the OpenAI Chat Completions API. Requires `OPENAI_API_KEY`+ or `OPENAI_KEY`. Defaults to `gpt-4o-mini` when no model is+ configured.++CONFIGURATION++Provider and model values resolve independently from module variables.+The first non-blank value wins:++ 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++Set personal defaults globally:++ seihou config set agent.provider codex-cli --global+ seihou config set agent.model gpt-5 --global++Use environment variables for a temporary shell session:++ export SEIHOU_AGENT_PROVIDER=openai+ export SEIHOU_AGENT_MODEL=gpt-4o-mini++SUBCOMMANDS++ seihou agent assist [PROMPT]+ Render a prompt for creating or modifying Seihou modules. The+ prompt includes current project context, available modules, and+ the module schema.++ seihou agent bootstrap [PROMPT] [--repo]+ Render a prompt for creating a new module from scratch. With+ `--repo`, target a multi-module repository with+ `seihou-registry.dhall`.++ seihou agent setup [PROMPT]+ Render a prompt for using existing Seihou modules in a project:+ selecting modules, configuring variables, previewing, running,+ verifying, and committing.++ seihou agent run BLUEPRINT [PROMPT] [--var KEY=VALUE] [--no-baseline]+ Resolve a blueprint, optionally apply its baseline modules,+ render the blueprint prompt, and send it to the configured+ provider. A successful non-debug run records applied-blueprint+ provenance in `.seihou/manifest.json`.++ seihou prompt run PROMPT [USER-PROMPT] [--var KEY=VALUE] [--debug]+ Resolve a reusable prompt, run command-derived variables, render+ the prompt body, and send it to the configured provider. Prompts+ do not apply blueprint baselines or record blueprint provenance.++DEBUG EXAMPLES++ seihou agent --debug --provider claude-cli assist "inspect this prompt"+ seihou agent --debug --provider codex-cli bootstrap --repo "inspect this prompt"+ seihou agent --debug --provider openai setup "inspect this prompt"+ seihou agent --debug run my-blueprint --var project.name=demo++SEE ALSO++ seihou agent --help+ seihou help config+ seihou help variables+ seihou help prompts+ docs/cli/agent.md+ docs/user/config-and-variables.md
+ help/blueprints.md view
@@ -0,0 +1,138 @@+BLUEPRINTS++A blueprint is an agent-driven runnable artifact. Modules and recipes use+Seihou's deterministic execution engine to write files from declared steps.+Blueprints instead package a prompt, optional baseline modules, variables,+and reference files for `seihou agent run`.++Use a blueprint when the desired output needs judgement, iteration, or+project-specific design decisions that do not fit a fixed module template.+Use a module or recipe when the same inputs should always produce the same+file plan.++BLUEPRINT STRUCTURE++ A blueprint directory looks like:++ my-blueprint/+ blueprint.dhall Blueprint definition (required)+ prompt.md Markdown prompt imported by blueprint.dhall+ files/ Optional reference files for the agent+ example.md+ config.sample++ `seihou new-blueprint my-blueprint` creates this layout. The generated+ `blueprint.dhall` imports `prompt.md` as Text so authors can edit the+ prompt as normal Markdown instead of escaping it through a Dhall string.++SCHEMA FIELDS++ The Dhall record uses the Blueprint schema:++ name Blueprint name. Must match [a-z][a-z0-9-]*.+ version Optional dotted version for provenance and status.+ description Optional human-facing summary.+ prompt Required prompt body. Usually `./prompt.md as Text`.+ vars Variables resolved before the prompt is rendered.+ prompts Interactive questions for missing required variables.+ baseModules Modules or recipes to apply before the agent runs.+ 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.++ 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`.++VARIABLES AND PROMPTS++ Blueprint variables use the same declaration and resolution model as+ module variables:++ seihou agent run my-blueprint --var project.name=demo++ Resolution follows the normal precedence chain: CLI overrides, environment,+ local config, namespace config, context config, global config, defaults,+ then interactive prompts. Resolved values are substituted into the blueprint+ prompt with `{{variable.name}}` placeholders before the agent sees it.++ `seihou vars my-blueprint` lists a blueprint's declared variables.++BASELINE MODULES++ `baseModules` lets a blueprint apply deterministic scaffolding before the+ agent starts. This is useful for stable foundations such as a language+ skeleton, Nix setup, CI defaults, or shared repository conventions.++ Each base module entry has the same dependency shape used by recipes:++ { module = "haskell-base"+ , vars = [ { name = "project.name", value = "demo" } ]+ }++ Base modules must resolve to modules or recipes, not other blueprints. The+ agent runner records the applied blueprint in `.seihou/manifest.json` after+ a successful run, including baseline provenance.++REFERENCE FILES++ Files declared in the `files` list must live under the blueprint's `files/`+ directory:++ files =+ [ { src = "example.md", description = Some "Reference README style" }+ ]++ Reference files are meant for examples, snippets, partial templates, design+ notes, or sample configs that help the agent produce the right project. They+ are not copied automatically by the deterministic engine. During interactive+ `claude-cli` and `codex-cli` runs, the runner mounts the existing `files/`+ directory and prints its absolute path in the agent prompt so the agent can+ read references directly. API providers receive fallback guidance because+ they cannot access local directories.++ALLOWED TOOLS++ `allowedTools` grants a blueprint extra tools beyond the base set required by+ every blueprint run. The runner keeps the base tools first and removes+ duplicates:++ allowedTools = Some [ "Bash(cabal *)", "Bash(mori *)" ]++ Claude Code receives the effective set through `--allowedTools`. Codex keeps+ its workspace-write sandbox and on-request approval policy because it has no+ equivalent per-tool allow-list option.++COMMON COMMANDS++ seihou new-blueprint api-service Scaffold a blueprint+ seihou validate-blueprint api-service Check blueprint.dhall and files/+ seihou list List modules, recipes, blueprints, and prompts+ seihou vars api-service Show blueprint variables+ seihou agent run api-service Run the blueprint with an agent++ `seihou run api-service` refuses when `api-service` resolves to a blueprint.+ That command is reserved for deterministic modules and recipes; use+ `seihou agent run` for blueprints.++VALIDATION++ `seihou validate-blueprint [PATH]` checks that:++ - blueprint.dhall exists and evaluates+ - the name, version, tags, and allowed tool entries are valid+ - the prompt body is non-empty+ - variables are unique+ - prompts reference declared variables+ - baseModules resolve to modules or recipes+ - declared reference files exist under files/++ If validation fails, fix the reported check before publishing or running+ the blueprint.++FURTHER READING++ docs/cli/new-blueprint.md command reference for scaffolding+ docs/cli/validate-blueprint.md command reference for validation+ seihou help variables variable precedence and overrides+ seihou help modules deterministic module authoring
+ help/config.md view
@@ -0,0 +1,64 @@+CONFIG++Seihou uses Dhall config files to store variable values that modules can+reference during scaffolding. Config values are organized into scopes, and+the effective config is the merge of all applicable scopes.++CONFIG SCOPES++ Seihou resolves config from four scopes, in priority order:++ 1. Local .seihou/config.dhall in the current project+ 2. Namespace ~/.config/seihou/namespaces/<ns>/config.dhall+ 3. Context ~/.config/seihou/contexts/<ctx>/config.dhall+ 4. Global ~/.config/seihou/config.dhall++ Higher-priority scopes override lower ones. Local config is specific to+ a single project, while global config applies everywhere.++READING AND WRITING CONFIG++ seihou config set project.name my-app Set a local value+ seihou config get project.name Read a value+ seihou config unset project.name Remove a value+ seihou config list List all values in scope+ seihou config list --effective Show merged config across all scopes++ Scope flags:++ --global, -g Target global scope+ --namespace NS, -n Target a namespace scope+ --context CTX, -c Target a context scope++ Without any scope flag, commands operate on the local project scope.++INITIALIZATION++ seihou init++ Creates ~/.config/seihou/ with subdirectories for modules, installed+ modules, and a default config.dhall. Safe to run multiple times.++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+ MODULE --explain' to see where each value comes from.++TYPICAL SETUP++ Set up global defaults that apply everywhere:++ seihou config set author.name "Your Name" --global+ seihou config set author.email "you@example.com" --global+ seihou config set license MIT --global++ Override per-project:++ cd ~/projects/my-app+ seihou config set project.name my-app++ Use namespaces for language-specific defaults:++ seihou config set ghc-version 9.12.2 --namespace haskell
+ help/contexts.md view
@@ -0,0 +1,58 @@+CONTEXTS++Contexts let you maintain separate configurations for different environments+— for example, "work" and "personal" — so that variables like author.email+resolve to different values depending on which context is active.++HOW CONTEXTS WORK++ A context is a named directory under ~/.config/seihou/contexts/ containing+ a config.dhall file:++ ~/.config/seihou/contexts/work/config.dhall+ ~/.config/seihou/contexts/personal/config.dhall++ When a context is active, its config values participate in variable+ resolution alongside local and global config. This means you can set+ author.email = "me@work.com" in your work context and+ author.email = "me@home.com" in your personal context.++SETTING AND CLEARING CONTEXTS++ seihou context set work Set project context (writes .seihou/context)+ seihou context default personal Set global default (~/.config/seihou/default-context)+ seihou context show Show active context and its source+ seihou context clear Remove project context+ seihou context clear-default Remove global default++RESOLUTION CHAIN++ 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++ The project context takes priority, so you can have a global default of+ "personal" but override it to "work" in specific project directories.++TYPICAL USE CASE++ Set up two contexts with different author info:++ seihou config set author.name "Work Name" --context work+ seihou config set author.email "me@work.com" --context work+ seihou config set author.name "Personal Name" --context personal+ seihou config set author.email "me@home.com" --context personal++ Then in a work project:++ cd ~/work/my-project+ seihou context set work+ seihou run haskell-base # uses work author info++ And in a personal project:++ cd ~/personal/my-project+ seihou context set personal+ seihou run haskell-base # uses personal author info
+ help/git-repository.md view
@@ -0,0 +1,88 @@+GIT REPOSITORY++Seihou modules, recipes, blueprints, and prompts can be shared and installed from git+repositories. A repository can contain a single runnable item or multiple items+organized as a registry.++SINGLE-MODULE REPOSITORY++ A repository with a module.dhall at the root is treated as a single+ module. When installed, the module name defaults to the repository name.++ my-module/+ module.dhall+ templates/+ ...++ Install with:++ seihou install https://github.com/user/my-module.git+ seihou install https://github.com/user/my-module.git --name custom-name++SINGLE-RECIPE, SINGLE-BLUEPRINT, OR SINGLE-PROMPT REPOSITORY++ A repository with a recipe.dhall, blueprint.dhall, or prompt.dhall at the+ root is treated as a single recipe, single blueprint, or single prompt.+ Install it the same way:++ seihou install https://github.com/user/my-recipe.git+ seihou install https://github.com/user/my-blueprint.git+ seihou install https://github.com/user/my-prompt.git++ Recipes run through `seihou run`; blueprints run through+ `seihou agent run`; prompts run through `seihou prompt run`.++REGISTRY REPOSITORY++ A repository with a seihou-registry.dhall at the root is treated as a+ registry containing multiple modules, recipes, blueprints, and prompts. Each item+ lives in its own subdirectory with its own runnable definition.++ my-templates/+ seihou-registry.dhall+ modules/haskell-base/module.dhall+ recipes/haskell-library/recipe.dhall+ blueprints/api-service/blueprint.dhall+ prompts/review-changes/prompt.dhall++ The registry file declares available items with descriptions, versions, and+ tags. Install specific items, all items, or choose interactively:++ seihou install https://github.com/user/templates.git --module haskell-base+ seihou install https://github.com/user/templates.git --all+ seihou install https://github.com/user/templates.git # interactive++BROWSING BEFORE INSTALLING++ Use 'seihou browse' to inspect a repository without installing anything:++ seihou browse https://github.com/user/templates.git+ seihou browse https://github.com/user/templates.git --tag haskell++ For registry repos, this lists all items with descriptions and tags.++WHERE ITEMS ARE INSTALLED++ Installed items are stored under ~/.config/seihou/installed/<name>/.+ They appear alongside user-created modules, recipes, blueprints, and prompts in the+ search path:++ 1. .seihou/modules/ Project-local items+ 2. ~/.config/seihou/modules/ User items+ 3. ~/.config/seihou/installed/ Installed (from git)++BOOTSTRAPPING A NEW REPOSITORY++ The agent bootstrap command can create a new module or registry repository+ structure for you:++ seihou agent bootstrap # single module+ seihou agent bootstrap --repo # multi-module with registry++UPGRADE WORKFLOW++ Once installed, modules can be upgraded with `seihou upgrade`. If a newer+ module version ships migrations (for renames,+ deletions, etc.), the upgrade command surfaces them via an advisory; running+ `seihou migrate <module>` is the post-upgrade step that applies them+ to the current project. See `seihou help migrations`.
+ help/kit.md view
@@ -0,0 +1,59 @@+KIT — MANAGE CLAUDE CODE AND CODEX SKILLS AND SUBAGENTS++Seihou Kit lets you install, update, and remove skills and subagents from+a remote repository (seihou-kit). Install writes provider-native copies+for both Claude Code and Codex.++COMMANDS++ seihou kit list List available skills and agents+ seihou kit install NAME Install to user scope (global)+ seihou kit install NAME --project Install to project scope (local)+ seihou kit update Pull latest and re-install all+ seihou kit update NAME Pull latest and re-install one+ seihou kit uninstall NAME Remove from user scope+ seihou kit uninstall NAME --project Remove from project scope+ seihou kit status Show installed items with scope, providers, and state++SCOPES++ User scope (default):+ ~/.config/seihou/agents/.claude/skills/<name>/+ ~/.config/seihou/agents/.claude/agents/<name>.md+ ~/.agents/skills/<name>/+ ~/.codex/agents/<name>.toml+ Available across all projects.++ Project scope (--project):+ .seihou/agents/.claude/skills/<name>/+ .seihou/agents/.claude/agents/<name>.md+ .agents/skills/<name>/+ .codex/agents/<name>.toml+ Scoped to the current project. Can be version-controlled.++HOW IT WORKS++ The kit repository is shallow-cloned to ~/.cache/seihou/kit/ on first+ use. Subsequent operations pull updates with git pull --ff-only.++ A kit.json manifest at the repo root enumerates all available skills+ and agents. The install command copies files from the cache to the+ target scope directory.++ Each installed item writes a .seihou-kit.json sidecar next to the+ provider-native files so status and update can report whether the+ installed copy is current, modified, or missing.++ When you run seihou agent assist (or bootstrap, setup), installed+ Claude scope directories are passed to Claude Code via --add-dir+ flags. Claude Code discovers .claude/skills/ and .claude/agents/+ within each add-dir automatically.++ Codex discovers skills from .agents/skills and custom agents from+ .codex/agents in the project, or from ~/.agents/skills and+ ~/.codex/agents for user scope. Kit agent Markdown is converted into+ Codex custom-agent TOML when installed.++ The cache is disposable — delete ~/.cache/seihou/kit/ and it will+ be re-cloned on next use. If the network is unavailable but cached+ data exists, commands continue with cached data.
+ help/migrations.md view
@@ -0,0 +1,176 @@+MIGRATIONS++A migration is an author-declared sequence of file-system operations that+moves a project's working tree from one module version to another. When a+module is upgraded — say, from haskell-base 1.0.0 to 2.0.0 — the project+that has it applied may need to rename directories, drop files that v2+doesn't ship, or run a one-off command. Migrations let module authors+ship that knowledge inside `module.dhall` so consumers don't have to read+a CHANGELOG and reconcile by hand.++WHEN TO AUTHOR A MIGRATION++ Add a migration when a new version of your module changes the *layout*+ of the files it generates: a directory rename, a file removal, a path+ pattern shift. You do not need a migration for content-only changes;+ re-running `seihou run <module>` already updates file content. Use+ migrations specifically for things that `seihou run` cannot infer on+ its own.++THE MIGRATION RECORD++ Each migration is one record in the `migrations` field of `module.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" }+ ]+ }+ ]++ - `from` and `to` are dotted versions parsed by `parseVersion`.+ - `ops` is the list of operations applied in order.++OPERATIONS++ Authors compose migrations from five typed operations:++ MoveFile Rename a single tracked file. The engine rewrites the+ manifest's files-map key from src to dest so subsequent+ `seihou status` and `seihou diff` keep working.++ S.MigrationOp.MoveFile { src = "lib/Old.hs", dest = "src/New.hs" }++ MoveDir Rename a directory. Every manifest entry whose path lies+ under src/ has its key rewritten with the dest/ prefix.++ S.MigrationOp.MoveDir { src = "app", dest = "src" }++ DeleteFile Remove a tracked file. Drops the manifest entry.++ S.MigrationOp.DeleteFile { path = "Setup.hs" }++ DeleteDir Recursively remove a directory and drop every manifest+ entry under that prefix.++ S.MigrationOp.DeleteDir { path = "obsolete" }++ RunCommand Run a shell command. The escape hatch for changes the+ other ops can't express. The manifest is *not*+ automatically updated; if your command moves files, you+ are responsible for following it with explicit+ MoveFile/DeleteFile ops or living with manifest drift.++ S.MigrationOp.RunCommand+ { run = "cabal run my-tool -- migrate", workDir = None Text }++WINDOW SEMANTICS++ When a user runs `seihou migrate`, the planner walks every declared+ migration whose [from, to] range falls inside [installed, target] in+ ascending `from` order, advancing a cursor as it goes. Migrations+ whose `from` is already past the cursor (overlap or stale) are+ skipped silently; migrations whose `to` exceeds the target are+ skipped (a future invocation with a higher target will pick them+ up).++ The cursor never has to land on a declared `from`. Gaps are+ permitted:++ installed: 0.2 target: 0.6+ declared: 0.2 → 0.3, 0.5 → 0.6++ Both edges run in order. The 0.3 → 0.5 gap has no declared+ migration and the planner does not stop — it skips the gap and+ keeps walking.++MANIFEST ALWAYS LANDS AT TARGET++ After a successful (non-dry-run) migration, the manifest's recorded+ version for the module advances to the supplied target — regardless+ of whether any of the declared migrations bridged every gap. A plan+ with zero in-window migrations is a "pure version bump" that+ advances the manifest's `moduleVersion` field without running any+ ops. The terms "blocked migration", "benign upgrade", and+ "bump-through" are gone; every invocation either has nothing to do+ (`installed == target`) or lands the manifest at the target.++DUPLICATES AND OVERLAPS++ If two migrations share the same `from`, that is an ambiguity and+ the planner refuses (`MigrationDuplicateEdge`). Authors who want a+ "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.++CONFLICT SEMANTICS++ Mirroring `seihou remove`, the engine classifies each+ file-targeted op into one of three states before touching disk:++ MFSafe Disk hash matches the manifest's recorded hash. Free+ to move or delete.+ MFConflict Disk hash differs. The user has edited the file since+ it was generated. The engine refuses to overwrite+ unless `--force` is passed.+ MFGone File is absent on disk. The op is a no-op.++ The conflict check happens up front. With one or more `MFConflict`+ paths and no `--force`, no disk mutation occurs. With `--force`, the+ migration proceeds and the user-edited bytes ride along (a+ MoveFile preserves content; a DeleteFile drops it).++DRY RUN++ `seihou migrate <module> --dry-run` prints the plan and exits. The+ output is identical to a real run, minus the actual disk+ modifications. Use this before any non-trivial migration to see+ what would be touched.++ For a machine-readable form, pass `--json` (works alongside+ `--dry-run`).++UPGRADE INTEGRATION++ `seihou upgrade` updates the central installed copy under+ ~/.config/seihou/installed/<name>/ but does *not* rewrite project+ trees by default. After an upgrade that brings new migrations,+ `seihou upgrade` prints a one-line advisory:++ note: haskell-base has 1 migration(s) pending (1.0.0 → 2.0.0);+ run 'seihou migrate haskell-base'++ Pass `--with-migrations` to skip the advisory and run migrations+ for each upgraded module against the current project in one shot.++STATUS INTEGRATION++ `seihou status` shows a `Pending migration: <from> -> <to> (<N>+ step(s)). Run: seihou migrate <name>` sub-line under any applied+ module whose installed copy has advanced past the manifest's+ recorded version. `<N>` is the count of in-window declared+ migrations that will run; it may be zero (the version range has no+ applicable migrations and the run will only advance the manifest).+ The line is informational — use `seihou migrate <module>` to apply.++MANIFEST GUARANTEE++ After a successful (non-dry-run) migration, the manifest's files map+ reflects the new paths exactly: a MoveFile rewrites one key, a+ MoveDir rewrites every contained key, deletes drop their entries,+ and the manifest's `genAt` is bumped. The named applied module's+ `moduleVersion` is updated to the supplied target (which may differ+ from the highest `to` in the applied migrations — see "Manifest+ always lands at target" above). `seihou diff` after a clean+ migration is empty; `seihou status` shows no pending migrations.++SEE ALSO++ seihou migrate --help+ seihou upgrade --help+ docs/user/migrations.md
+ help/modules.md view
@@ -0,0 +1,92 @@+MODULES++A module is the basic unit of project scaffolding in Seihou. Each module is a+directory containing a module.dhall definition file and optional supporting+files (templates, static files, Dhall expressions).++MODULE SEARCH PATH++ Seihou searches for modules in three locations, in order:++ 1. Project modules .seihou/modules/<name>/+ 2. User modules ~/.config/seihou/modules/<name>/+ 3. Installed modules ~/.config/seihou/installed/<name>/++ The first match wins. Project modules shadow user modules, which shadow+ installed modules.++MODULE STRUCTURE++ A minimal module directory looks like:++ my-module/+ module.dhall Module definition (required)+ files/ Static and template files+ README.md.tpl Template file (rendered with variables)+ .gitignore Static file (copied as-is)++ The module.dhall file declares the module's name, description, variables,+ generation steps, and optional dependencies or exports.++GENERATION STRATEGIES++ Each step in a module uses one of four strategies:++ Copy Copy a file verbatim from the module to the output.+ Template Render a Mustache-style template with resolved variables.+ DhallText Evaluate a Dhall expression that produces Text output.+ Structured (Reserved for future structured merge support.)++DEPENDENCIES++ Modules can declare dependencies on other modules using the record form:++ dependencies =+ [ { module = "nix-base", vars = [] : List { name : Text, value : Text } }+ ]++ When you run a module, Seihou loads its dependencies first (topological+ sort) and resolves variables across the full dependency graph. Dependencies+ can export variables for downstream modules to consume.++ Dependencies can also supply variable bindings to child modules:++ { module = "nix-flake"+ , vars = [ { name = "nix.system", value = "x86_64-linux" } ]+ }++SCHEMA PACKAGE++ 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:++ let S =+ https://raw.githubusercontent.com/shinzui/seihou-schema/<commit>/package.dhall+ sha256:<hash>++ in S.Module::{ name = "my-module"+ , steps = [ S.Step::{ strategy = "template"+ , src = "foo.tpl", dest = "foo" } ]+ }++ Running `seihou new-module` generates modules in this format.+ Record completion fills in defaults for optional fields automatically.++COMMON COMMANDS++ 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 <git-url> Install modules, recipes, or blueprints from git+ seihou run <module> --var k=v Run a module to generate files+ seihou remove <module> Remove an applied module and its files+ seihou schema-upgrade ./my-module Upgrade module.dhall to current schema++VERSIONING AND MIGRATIONS++ Modules carry a `version` field that follows dotted-version semantics+ (1.0.0, 1.2.3, etc.). When an author bumps a module's version and+ changes its file layout, they can ship migrations alongside the new+ version that move existing project files into the new shape. Run+ `seihou help migrations` for the full reference.
+ help/prompts.md view
@@ -0,0 +1,119 @@+PROMPTS++A prompt is a reusable agent-session template. It renders a Markdown prompt+from Seihou variables, local command output, optional guidance blocks, optional+reference files, and an optional user instruction, then starts the configured+provider.++Use a prompt for repeatable agent workflows such as code review, release+preparation, planning, repository inspection, or dependency research. Use a+module or recipe for deterministic file generation. Use a blueprint when an+agent should scaffold or modify a project shape and optionally apply baseline+modules first.++PROMPT STRUCTURE++ A prompt directory looks like:++ review-changes/+ prompt.dhall Prompt definition (required)+ prompt.md Markdown body imported by prompt.dhall+ files/ Optional reference files for the agent++ `seihou new-prompt review-changes` creates this layout.++SCHEMA FIELDS++ name Prompt name. Must match [a-z][a-z0-9-]*.+ version Optional version for registries and installed origin metadata.+ description Optional human-facing summary.+ prompt Required prompt body. Usually `./prompt.md as Text`.+ vars Typed variables resolved before the prompt is rendered.+ prompts Interactive questions for missing typed variables.+ commandVars Variables filled by local command output.+ guidance Markdown instruction blocks selected after variables resolve.+ 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.++ Prompts share the same name lookup namespace as modules, recipes, and+ blueprints. If a directory contains multiple runnable definitions, lookup+ prefers `module.dhall`, then `recipe.dhall`, then `blueprint.dhall`, then+ `prompt.dhall`.++VARIABLES++ Prompt variables use the standard Seihou precedence chain:++ CLI --var, environment, local config, namespace config, context config,+ global config, defaults, interactive prompts.++ Example:++ seihou config set project.name seihou --global+ seihou prompt run review-changes --debug++ A `prompt.md` body containing `{{project.name}}` will render the configured+ value unless a higher-precedence source overrides it.++COMMAND-DERIVED VARIABLES++ `commandVars` fill placeholders from local command output after normal+ variables resolve:++ { name = "git.branch"+ , run = "git branch --show-current"+ , workDir = None Text+ , when = None Text+ , trim = True+ , maxBytes = Some 4096+ }++ Use command variables for compact local context such as branch names, diff+ stats, test summaries, or file lists. Non-zero exits fail rendering, and+ `maxBytes` limits captured output.++PROMPT GUIDANCE++ `guidance` adds Markdown instruction blocks around the prompt body in the+ provider prompt. Use it for repository workflow rules, project-specific+ validation commands, or adaptation based on command-derived variables.++ guidance =+ [ { title = "Haskell repository"+ , body = "Prefer cabal build all and focused cabal test commands."+ , when = Some "Eq repo.kind haskell"+ }+ ]++ Guidance does not apply blueprint baseline modules and does not write+ applied-blueprint provenance.++COMMON COMMANDS++ seihou new-prompt review-changes Scaffold a prompt+ seihou validate-prompt review-changes Check prompt.dhall and files/+ seihou prompt run review-changes Run the prompt with a provider+ seihou prompt run review-changes --debug+ Print the complete provider prompt+ seihou list --prompts Show only prompt artifacts++PUBLISHING++ Registries can list prompts alongside modules, recipes, and blueprints in a+ `prompts = [...]` field. Install prompt entries with the existing registry+ selector:++ seihou install GIT-URL --module review-changes++ The selector flag is still named `--module` for compatibility, but it can+ select any registry entry kind.++FURTHER READING++ docs/user/prompts.md prompt authoring guide+ docs/cli/new-prompt.md command reference for scaffolding+ docs/cli/validate-prompt.md command reference for validation+ docs/cli/prompt.md command reference for running prompts+ seihou help variables variable precedence and overrides
+ help/templating.md view
@@ -0,0 +1,177 @@+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+regions of text on a boolean expression via {{#if ...}} blocks.++Templates stay intentionally dumb. Anything richer -- loops, arithmetic,+derived values, multi-way branching -- belongs to the DhallText strategy,+which evaluates a full Dhall expression after placeholder substitution.+When a template starts fighting you, switch the step to dhall-text rather+than contort the template.++PLACEHOLDERS++ Syntax:++ {{variable.name}} standard form+ {{ variable.name }} surrounding whitespace inside the braces is ignored+ \{{variable.name}} literal "{{variable.name}}" in output (escape)++ Variable names match [a-zA-Z][a-zA-Z0-9._-]*. Dots are part of the+ name, not structural.++ Coercion from the resolved value to text:++ VText "hello" -> hello+ VBool True -> true+ VBool False -> false+ VInt 42 -> 42+ VList ["a", "b"] -> a,b (comma-separated, recursive)++ Placeholder substitution runs in three positions:++ Template bodies the .tpl file contents+ Destination path the `dest` field of a step+ Shell commands the `run` and `workDir` fields of command steps++ESCAPING {{++ \{{ is consumed and emits a literal {{ in the output. There is no+ corresponding \}} escape -- unmatched closers are emitted verbatim.++ Use \{{name}} for placeholders -> Use {{name}} for placeholders++ The escape applies to placeholder syntax only. There is no escape+ for block tags; a template cannot emit a literal {{#if sequence.+ Use the DhallText strategy when that is required.++CONDITIONAL BLOCKS++ Inline blocks gate regions of a template body on a boolean expression:++ {{#if EXPR}} ... {{/if}}+ {{#if EXPR}} ... {{#else}} ... {{/if}}++ Blocks nest to arbitrary depth; a {{/if}} always pairs with its+ nearest open {{#if}}.++ Only the selected branch is expanded. The untaken branch's text is+ discarded before it reaches the placeholder engine. Unresolved+ placeholders and malformed sub-expressions inside the untaken branch+ therefore do not produce errors. This is deliberate: it lets authors+ gate optional features without having to declare every variable+ 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+ 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.++EXPRESSION LANGUAGE++ The grammar used by {{#if ...}} (and by step-level `when` clauses):++ expr = or_expr+ or_expr = and_expr ("||" and_expr)*+ and_expr = not_expr ("&&" not_expr)*+ not_expr = "!" atom | atom+ atom = "IsSet" NAME+ | "Eq" NAME VALUE+ | "(" expr ")"+ | "true" | "false"+ VALUE = "quoted string" | bareWord++ IsSet foo true iff foo has a resolved value.+ Eq foo VALUE true iff foo's value equals VALUE. Values are+ type-sensitive: a bool variable compares against+ bare-word true/false, not against quoted "true".+ A text variable compares against a quoted string.+ && || ! the usual boolean operators.+ ( ... ) parentheses group sub-expressions.+ true / false literal constants.++STANDALONE TAG WHITESPACE++ A block tag is standalone on its line when everything before it on+ the line is spaces or tabs (or the line starts with the tag) AND+ everything after it is spaces or tabs followed by a newline (or the+ template ends). A standalone tag absorbs its leading indent and one+ trailing newline. A tag that shares a line with other content keeps+ all surrounding whitespace verbatim.++ So the readable form:++ prev+ {{#if Eq flag true}}+ body+ {{/if}}+ next++ emits `prev\n body\nnext\n` when flag = True and `prev\nnext\n`+ when flag = False -- no blank-line cruft either way. The body's+ indentation is preserved; the tag lines' indentation is not.++ Only ASCII space (0x20) and tab (0x09) qualify. NBSP and other+ Unicode whitespace do NOT trigger the trim.++ A blank line INSIDE a block body survives the trim, so to emit a+ deliberate blank separator at the boundary of a gated region, put+ the blank inside the block body rather than outside it.++ERRORS++ The engine reports five error kinds, each with a line number:++ UnresolvedPlaceholder {{name}} references a variable with no value.+ MalformedPlaceholder {{ opened on a line without a closing }}.+ UnterminatedIf {{#if}} opener with no matching {{/if}}.+ OrphanBlockToken {{/if}} or {{#else}} outside any open {{#if}}.+ MalformedIfExpression The expression inside {{#if ...}} failed to parse.++ Block-level errors point at the source line of the offending tag.+ Placeholder errors inside a taken branch report a line number measured+ in the post-expansion text, which may drift from the source line by+ the number of newlines absorbed by standalone-trim; the variable name+ and relative position are still informative.++COMMON PATTERNS++ Optional single line:++ nativeBuildInputs = [+ pkgs.cabal-install+ {{#if Eq nix.postgresql true}}+ pkgs.postgresql+ {{/if}}+ ];++ If / else with a default (kept on one line so the output is one line):++ runtime = "{{#if IsSet docker.registry}}{{docker.registry}}/{{project.name}}{{#else}}{{project.name}}{{/if}}";++ Version-gated content (Eq does string-equal for text variables):++ {{#if Eq ghc.version "ghc912"}}+ -- ghc912-specific build flags+ ghc-options: -Wno-x-partial+ {{/if}}++WHEN TO USE DHALL-TEXT INSTEAD++ Switch the step's strategy from `template` to `dhall-text` (freeform+ Text) or `structured` (JSON / YAML with record-level composition)+ when you need to loop over a list, compute a derived value (for+ example, major.minor from ghc.version), choose among more than a+ handful of discrete cases, or merge structured data across modules.+ Both strategies substitute {{variable}} placeholders first, then+ evaluate the resulting Dhall expression -- so you still get variable+ interpolation on the way in and the full power of Dhall on the way out.++FURTHER READING++ docs/user/templating.md full reference (this topic condensed)+ docs/user/module-authoring.md variables, steps, and strategies in context+ docs/user/config-and-variables.md how variables are resolved
+ help/variables.md view
@@ -0,0 +1,52 @@+VARIABLES++Variables are named, typed values that modules use to customize generated+output. They are declared in module.dhall and resolved at generation time+from multiple sources.++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.++RESOLUTION ORDER++ When resolving a variable's value, Seihou checks these sources in order:++ 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++ The first source that provides a value wins.++EXPORTS++ A module can export variables so that dependent modules can use them.+ Exports are declared in module.dhall and make a variable's resolved value+ available to any module that depends on this one.++INSPECTING VARIABLES++ seihou vars <module> List declared variables+ seihou vars <module> --explain Show resolved values with provenance+ seihou vars <module> --var k=v Supply values for resolution++ The --explain flag is especially useful for debugging: it shows where each+ variable's value came from (CLI, config, default, export, etc.).++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.
+ seihou-cli.cabal view
@@ -0,0 +1,246 @@+cabal-version: 3.0+name: seihou-cli+version: 0.4.0.0+synopsis: CLI for Seihou project scaffolding+description:+ Command-line interface for Seihou, a composable project scaffolding+ system. It creates and manages typed scaffolding modules, blueprints,+ migrations, registry operations, and project-local configuration.++homepage: https://github.com/shinzui/seihou+bug-reports: https://github.com/shinzui/seihou/issues+license: BSD-3-Clause+license-file: LICENSE+author: Nadeem Bitar+maintainer: nadeem@gmail.com+copyright: (c) 2026 Nadeem Bitar+category: Development+build-type: Simple+extra-source-files:+ data/assist-prompt.md+ data/blueprint-prompt.md+ data/bootstrap-prompt.md+ data/prompt-run-prompt.md+ data/setup-prompt.md+ help/agent.md+ help/blueprints.md+ help/config.md+ help/contexts.md+ help/git-repository.md+ help/kit.md+ help/migrations.md+ help/modules.md+ help/prompts.md+ help/templating.md+ help/variables.md++source-repository head+ type: git+ location: https://github.com/shinzui/seihou.git++library seihou-cli-internal+ default-language: GHC2024+ default-extensions:+ DuplicateRecordFields+ NoFieldSelectors+ OverloadedLabels+ OverloadedRecordDot+ OverloadedStrings+ TypeFamilies++ hs-source-dirs: src+ visibility: private+ exposed-modules:+ Seihou.CLI.AgentCompletion+ Seihou.CLI.AgentConfig+ Seihou.CLI.AgentLaunch+ Seihou.CLI.AppliedBlueprint+ Seihou.CLI.BrowseFormat+ Seihou.CLI.CommitMessage+ Seihou.CLI.Completions.Bash+ Seihou.CLI.Completions.Fish+ Seihou.CLI.Completions.Zsh+ Seihou.CLI.Diff+ Seihou.CLI.Extension+ Seihou.CLI.Git+ Seihou.CLI.Init+ Seihou.CLI.InstallHistory+ Seihou.CLI.InstallShared+ Seihou.CLI.List+ Seihou.CLI.Migrate+ Seihou.CLI.PendingMigrations+ Seihou.CLI.PromptRender+ Seihou.CLI.Registry+ Seihou.CLI.Registry.Sync+ Seihou.CLI.Registry.Validate+ Seihou.CLI.RemoteVersion+ Seihou.CLI.SavePrompted+ Seihou.CLI.SchemaVersion+ Seihou.CLI.Shared+ Seihou.CLI.StatusRender+ Seihou.CLI.Style+ Seihou.CLI.VersionCompare+ Seihou.Effect.Fzf+ Seihou.Effect.FzfInterp+ Seihou.Fzf+ Seihou.Fzf.Selector+ Seihou.Fzf.Selector.Module++ build-depends:+ aeson >=2.1 && <3,+ aeson-pretty >=0.8 && <1,+ ansi-terminal >=1.1 && <2,+ baikai ^>=0.3.0.0,+ baikai-claude ^>=0.3.0.0,+ baikai-openai ^>=0.3.0.0,+ base >=4.18 && <5,+ bytestring >=0.11 && <1,+ containers >=0.6 && <1,+ directory >=1.3 && <2,+ effectful-core >=2.4 && <3,+ file-embed >=0.0.15 && <1,+ filepath >=1.4 && <2,+ process >=1.6 && <2,+ seihou-core ^>=0.4.0.0,+ temporary >=1.3 && <2,+ text >=2.0 && <3,+ time >=1.12 && <2,+ vector ^>=0.13.2.0,++executable seihou+ default-language: GHC2024+ ghc-options: -threaded+ default-extensions:+ DuplicateRecordFields+ NoFieldSelectors+ OverloadedLabels+ OverloadedRecordDot+ OverloadedStrings+ TypeFamilies++ hs-source-dirs: src-exe+ main-is: Main.hs+ autogen-modules: Paths_seihou_cli+ -- Every module below is "trapped" in the executable target by one+ -- of: Options.Applicative, Data.FileEmbed, GitHash,+ -- Paths_seihou_cli, or — transitively — another trapped seihou+ -- module (most often Seihou.CLI.Commands). For the per-module+ -- trapping reason, see docs/dev/architecture/overview.md, section+ -- "CLI Module Placement Convention" and its "Trapped-modules+ -- inventory" subsection. New code should default to the+ -- seihou-cli-internal library at hs-source-dirs: src.+ other-modules:+ Paths_seihou_cli+ Seihou.CLI.AgentLaunchExec+ Seihou.CLI.AgentRun+ Seihou.CLI.Assist+ Seihou.CLI.Bootstrap+ Seihou.CLI.Browse+ Seihou.CLI.Commands+ Seihou.CLI.Completions+ Seihou.CLI.Config+ Seihou.CLI.Context+ Seihou.CLI.Help+ Seihou.CLI.Install+ Seihou.CLI.Kit+ Seihou.CLI.NewBlueprint+ Seihou.CLI.NewModule+ Seihou.CLI.NewPrompt+ Seihou.CLI.NewRecipe+ Seihou.CLI.Outdated+ Seihou.CLI.PromptRun+ Seihou.CLI.Remove+ Seihou.CLI.Run+ Seihou.CLI.SchemaUpgrade+ Seihou.CLI.Setup+ Seihou.CLI.Status+ Seihou.CLI.Upgrade+ Seihou.CLI.Validate+ Seihou.CLI.ValidateBlueprint+ Seihou.CLI.ValidatePrompt+ Seihou.CLI.Vars+ Seihou.CLI.Version++ build-depends:+ aeson >=2.1 && <3,+ aeson-pretty >=0.8 && <1,+ ansi-terminal >=1.1 && <2,+ baikai ^>=0.3.0.0,+ baikai-claude ^>=0.3.0.0,+ baikai-kit ^>=0.1.0.1,+ baikai-openai ^>=0.3.0.0,+ base >=4.18 && <5,+ bytestring >=0.11 && <1,+ containers >=0.6 && <1,+ directory >=1.3 && <2,+ effectful-core >=2.4 && <3,+ file-embed >=0.0.15 && <1,+ filepath >=1.4 && <2,+ githash ^>=0.1,+ optparse-applicative >=0.18 && <1,+ process >=1.6 && <2,+ seihou-cli-internal,+ seihou-core ^>=0.4.0.0,+ temporary >=1.3 && <2,+ text >=2.0 && <3,+ time >=1.12 && <2,++test-suite seihou-cli-test+ type: exitcode-stdio-1.0+ default-language: GHC2024+ default-extensions:+ DuplicateRecordFields+ NoFieldSelectors+ OverloadedLabels+ OverloadedRecordDot+ OverloadedStrings++ hs-source-dirs: test+ main-is: Main.hs+ default-extensions:+ TypeFamilies++ other-modules:+ Seihou.CLI.AgentCompletionSpec+ Seihou.CLI.AgentConfigSpec+ Seihou.CLI.AgentLaunchSpec+ Seihou.CLI.AppliedBlueprintSpec+ Seihou.CLI.BrowseFormatSpec+ Seihou.CLI.CommitMessageSpec+ Seihou.CLI.DiffSpec+ Seihou.CLI.ExtensionSpec+ Seihou.CLI.GitSpec+ Seihou.CLI.InitSpec+ Seihou.CLI.InstallHistorySpec+ Seihou.CLI.ListSpec+ Seihou.CLI.MigrateSpec+ Seihou.CLI.PendingMigrationSpec+ Seihou.CLI.PromptRenderSpec+ Seihou.CLI.Registry.SyncSpec+ Seihou.CLI.Registry.ValidateSpec+ Seihou.CLI.RemoteVersionSpec+ Seihou.CLI.RunBlueprintRefusalSpec+ Seihou.CLI.SavePromptedSpec+ Seihou.CLI.StatusSpec+ Seihou.CLI.UpgradeSpec+ Seihou.FzfSpec++ build-depends:+ aeson >=2.1 && <3,+ baikai ^>=0.3.0.0,+ base >=4.18 && <5,+ bytestring >=0.11 && <1,+ containers >=0.6 && <1,+ directory >=1.3 && <2,+ effectful-core >=2.4 && <3,+ filepath >=1.4 && <2,+ hspec >=2.11 && <3,+ process >=1.6 && <2,+ seihou-cli-internal,+ seihou-core ^>=0.4.0.0,+ tasty >=1.4 && <2,+ tasty-hspec >=1.2 && <2,+ temporary >=1.3 && <2,+ text >=2.0 && <3,+ time >=1.12 && <2,+ vector ^>=0.13.2.0,
+ src-exe/Main.hs view
@@ -0,0 +1,162 @@+module Main (main) where++import Control.Applicative ((<|>))+import Data.List (isPrefixOf)+import Data.String (fromString)+import Data.Text (Text)+import Data.Text.IO qualified as TIO+import Options.Applicative (customExecParser, prefs, showHelpOnEmpty)+import Seihou.CLI.AgentCompletion qualified as AgentCompletion+import Seihou.CLI.AgentConfig (loadAgentModelConfig)+import Seihou.CLI.AgentRun (handleAgentRun)+import Seihou.CLI.Assist (handleAssist)+import Seihou.CLI.Bootstrap (handleBootstrap)+import Seihou.CLI.Browse (handleBrowse)+import Seihou.CLI.Commands+import Seihou.CLI.Completions (handleCompletionsCommand)+import Seihou.CLI.Config (handleConfig)+import Seihou.CLI.Context (handleContext)+import Seihou.CLI.Diff (handleDiff)+import Seihou.CLI.Extension (ExtensionRunOpts (..), handleExtensionRun)+import Seihou.CLI.Help (handleHelpCommand)+import Seihou.CLI.Init (handleInit)+import Seihou.CLI.Install (handleInstall)+import Seihou.CLI.Kit (runKit)+import Seihou.CLI.List (ListFilter (..), handleList)+import Seihou.CLI.Migrate (handleMigrate)+import Seihou.CLI.NewBlueprint (handleNewBlueprint)+import Seihou.CLI.NewModule (handleNewModule)+import Seihou.CLI.NewPrompt (handleNewPrompt)+import Seihou.CLI.NewRecipe (handleNewRecipe)+import Seihou.CLI.Outdated (handleOutdated)+import Seihou.CLI.PromptRun (handlePromptRun)+import Seihou.CLI.Registry (handleRegistry)+import Seihou.CLI.Remove (handleRemove)+import Seihou.CLI.Run (handleRun)+import Seihou.CLI.SchemaUpgrade (handleSchemaUpgrade)+import Seihou.CLI.Setup (handleSetup)+import Seihou.CLI.Status (handleStatus)+import Seihou.CLI.Upgrade (handleUpgrade)+import Seihou.CLI.Validate (handleValidateModule)+import Seihou.CLI.ValidateBlueprint (handleValidateBlueprint)+import Seihou.CLI.ValidatePrompt (handleValidatePrompt)+import Seihou.CLI.Vars (handleVars)+import Seihou.Core.Module (RunnableKind (..))+import System.Environment (getArgs)+import System.Exit (exitFailure)++main :: IO ()+main = do+ rawArgs <- getArgs+ case extensionRunFromRawArgs rawArgs of+ Just extensionRunOpts ->+ handleExtensionRun extensionRunOpts+ Nothing -> do+ cmd <- customExecParser (prefs showHelpOnEmpty) opts+ dispatch cmd++extensionRunFromRawArgs :: [String] -> Maybe ExtensionRunOpts+extensionRunFromRawArgs ("extension" : "run" : name : rest)+ | not ("-" `isPrefixOf` name) =+ Just+ ExtensionRunOpts+ { extensionName = fromString name,+ extensionArgs =+ case rest of+ "--" : forwarded -> forwarded+ forwarded -> forwarded+ }+extensionRunFromRawArgs _ = Nothing++dispatch :: Command -> IO ()+dispatch cmd =+ case cmd of+ Init ->+ handleInit+ Run runOpts ->+ handleRun runOpts+ Remove removeOpts ->+ handleRemove removeOpts+ Vars varsOpts ->+ handleVars varsOpts+ Install installOpts ->+ handleInstall installOpts+ Status statusOpts ->+ handleStatus statusOpts+ Diff ->+ handleDiff+ List listOpts ->+ let kinds =+ [KindModule | listOpts.listModulesOnly]+ <> [KindRecipe | listOpts.listRecipesOnly]+ <> [KindBlueprint | listOpts.listBlueprintsOnly]+ <> [KindPrompt | listOpts.listPromptsOnly]+ in handleList (ListFilter listOpts.listRepo listOpts.listTag kinds)+ NewModule newModOpts ->+ handleNewModule newModOpts+ NewRecipe newRecOpts ->+ handleNewRecipe newRecOpts+ NewBlueprint newBpOpts ->+ handleNewBlueprint newBpOpts+ NewPrompt newPromptOpts ->+ handleNewPrompt newPromptOpts+ ValidateModule validateOpts ->+ handleValidateModule validateOpts+ ValidateBlueprint validateBpOpts ->+ handleValidateBlueprint validateBpOpts+ ValidatePrompt validatePromptOpts ->+ handleValidatePrompt validatePromptOpts+ Config configOpts ->+ handleConfig configOpts+ Context contextAction ->+ handleContext contextAction+ Browse browseOpts ->+ handleBrowse browseOpts+ Outdated outdatedOpts ->+ handleOutdated outdatedOpts+ Upgrade upgradeOpts ->+ handleUpgrade upgradeOpts+ Migrate migrateOpts ->+ handleMigrate migrateOpts+ SchemaUpgrade schemaUpgradeOpts ->+ handleSchemaUpgrade schemaUpgradeOpts+ Registry registryCmd ->+ handleRegistry registryCmd+ Kit kitCmd ->+ runKit kitCmd+ Agent agentOpts -> do+ case agentOpts.agentCommand of+ AgentAssist assistOpts -> do+ modelConfig <- resolveAgentModelConfig agentOpts.agentProvider agentOpts.agentModel assistOpts.assistProvider assistOpts.assistModel+ handleAssist agentOpts.agentDebug modelConfig assistOpts+ AgentBootstrap bootstrapOpts -> do+ modelConfig <- resolveAgentModelConfig agentOpts.agentProvider agentOpts.agentModel bootstrapOpts.bootstrapProvider bootstrapOpts.bootstrapModel+ handleBootstrap agentOpts.agentDebug modelConfig bootstrapOpts+ AgentSetup setupOpts -> do+ modelConfig <- resolveAgentModelConfig agentOpts.agentProvider agentOpts.agentModel setupOpts.setupProvider setupOpts.setupModel+ handleSetup agentOpts.agentDebug modelConfig setupOpts+ AgentRun blueprintRunOpts -> do+ modelConfig <- resolveAgentModelConfig agentOpts.agentProvider agentOpts.agentModel blueprintRunOpts.runBlueprintProvider blueprintRunOpts.runBlueprintModel+ handleAgentRun agentOpts.agentDebug modelConfig blueprintRunOpts+ Prompt promptCmd -> do+ case promptCmd of+ PromptRun promptRunOpts -> do+ modelConfig <- resolveAgentModelConfig Nothing Nothing promptRunOpts.runPromptProvider promptRunOpts.runPromptModel+ handlePromptRun modelConfig promptRunOpts+ Extension extensionCmd -> do+ case extensionCmd of+ ExtensionRun extensionRunOpts ->+ handleExtensionRun extensionRunOpts+ HelpCmd helpCmd ->+ handleHelpCommand helpCmd+ Completions completionsCmd ->+ handleCompletionsCommand completionsCmd++resolveAgentModelConfig :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> IO AgentCompletion.AgentModelConfig+resolveAgentModelConfig parentProvider parentModel commandProvider commandModel = do+ configResult <- loadAgentModelConfig (commandProvider <|> parentProvider) (commandModel <|> parentModel)+ case configResult of+ Left err -> do+ TIO.putStrLn $ "Error: " <> err+ exitFailure+ Right config -> pure config
+ src-exe/Seihou/CLI/AgentLaunchExec.hs view
@@ -0,0 +1,115 @@+module Seihou.CLI.AgentLaunchExec+ ( launchConfiguredAgent,+ launchConfiguredAgentAddingDirs,+ launchConfiguredAgentWith,+ )+where++import Baikai.Interactive+ ( CodexApprovalPolicy (CodexApprovalOnRequest),+ CodexSandboxMode (CodexWorkspaceWrite),+ InteractiveLaunchResult (..),+ InteractiveSafety (ClaudeAllowedTools, CodexSandbox),+ extraDirs,+ interactiveLaunchRequest,+ modelId,+ safety,+ systemPrompt,+ workingDir,+ )+import Baikai.Kit.Session qualified as KitSession+import Baikai.Provider.Claude.Interactive+ ( defaultClaudeInteractiveConfig,+ launchClaudeInteractive,+ )+import Baikai.Provider.OpenAI.Interactive+ ( defaultCodexInteractiveConfig,+ launchCodexInteractive,+ )+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.AgentCompletion (AgentModelConfig (..), AgentProvider (..))+import Seihou.CLI.Kit (seihouKitConfig)+import Seihou.Prelude+import System.Directory (findExecutable, getCurrentDirectory)+import System.Exit (ExitCode (..), exitFailure)++launchConfiguredAgent :: AgentModelConfig -> [String] -> Bool -> Text -> Maybe Text -> IO ExitCode+launchConfiguredAgent = launchConfiguredAgentAddingDirs []++launchConfiguredAgentAddingDirs :: [FilePath] -> AgentModelConfig -> [String] -> Bool -> Text -> Maybe Text -> IO ExitCode+launchConfiguredAgentAddingDirs extraDirs modelConfig tools debug systemPrompt initialPrompt = do+ sessionDirs <- KitSession.agentDirsForSession seihouKitConfig+ launchConfiguredAgentWith (sessionDirs <> extraDirs) modelConfig tools debug systemPrompt initialPrompt++launchConfiguredAgentWith :: [FilePath] -> AgentModelConfig -> [String] -> Bool -> Text -> Maybe Text -> IO ExitCode+launchConfiguredAgentWith addDirs modelConfig tools debug systemPrompt initialPrompt+ | debug = do+ TIO.putStr systemPrompt+ pure ExitSuccess+ | otherwise =+ case modelConfig.agentProvider of+ AgentProviderClaudeCli ->+ launchClaude addDirs tools modelConfig.agentModel systemPrompt initialPrompt+ AgentProviderCodexCli ->+ launchCodex addDirs modelConfig.agentModel systemPrompt initialPrompt+ AgentProviderAnthropic ->+ unsupportedInteractiveProvider "anthropic"+ AgentProviderOpenAI ->+ unsupportedInteractiveProvider "openai"++launchClaude :: [FilePath] -> [String] -> Maybe Text -> Text -> Maybe Text -> IO ExitCode+launchClaude addDirs tools model systemPrompt initialPrompt = do+ claudePath <- findExecutable "claude"+ case claudePath of+ Nothing -> do+ TIO.putStrLn "Error: 'claude' CLI (Claude Code) not found on PATH."+ TIO.putStrLn "Install it from: https://docs.anthropic.com/en/docs/claude-code"+ exitFailure+ Just _ -> do+ cwd <- getCurrentDirectory+ InteractiveLaunchResult {exitCode} <-+ launchClaudeInteractive+ defaultClaudeInteractiveConfig+ (interactiveLaunchRequest (promptOrEmpty initialPrompt))+ { systemPrompt = Just systemPrompt,+ modelId = model,+ workingDir = Just cwd,+ extraDirs = addDirs,+ safety = ClaudeAllowedTools (map T.pack tools)+ }+ pure exitCode++launchCodex :: [FilePath] -> Maybe Text -> Text -> Maybe Text -> IO ExitCode+launchCodex addDirs model systemPrompt initialPrompt = do+ codexPath <- findExecutable "codex"+ case codexPath of+ Nothing -> do+ TIO.putStrLn "Error: 'codex' CLI not found on PATH."+ TIO.putStrLn "Install and authenticate Codex CLI, then retry."+ exitFailure+ Just _ -> do+ cwd <- getCurrentDirectory+ InteractiveLaunchResult {exitCode} <-+ launchCodexInteractive+ defaultCodexInteractiveConfig+ (interactiveLaunchRequest (promptOrEmpty initialPrompt))+ { systemPrompt = Just systemPrompt,+ modelId = model,+ workingDir = Just cwd,+ extraDirs = addDirs,+ safety = CodexSandbox CodexWorkspaceWrite CodexApprovalOnRequest+ }+ pure exitCode++promptOrEmpty :: Maybe Text -> Text+promptOrEmpty = maybe "" id++unsupportedInteractiveProvider :: Text -> IO ExitCode+unsupportedInteractiveProvider providerName = do+ TIO.putStrLn $+ "Error: provider '"+ <> providerName+ <> "' is an API provider and cannot start an interactive local agent session."+ TIO.putStrLn "Use --provider claude-cli or --provider codex-cli for interactive agent sessions."+ exitFailure
+ src-exe/Seihou/CLI/AgentRun.hs view
@@ -0,0 +1,536 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Agent runner for blueprints. Loads a blueprint, resolves its+-- variables (with the same precedence chain as @seihou run@), optionally+-- applies its declared @baseModules@, renders the prompt template, and+-- sends the rendered prompt through the configured Baikai provider. See EP-31+-- (docs/plans/31-blueprint-agent-runner.md) for the full design.+module Seihou.CLI.AgentRun+ ( handleAgentRun,+ appliedBlueprintFromOutcome,+ runRenderedAgentPrompt,+ )+where++import Control.Monad (when)+import Data.FileEmbed (embedFile)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, maybeToList)+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 Data.Time (UTCTime)+import Data.Time.Clock (getCurrentTime)+import Seihou.CLI.AgentCompletion+ ( AgentModelConfig (..),+ AgentProvider (..),+ buildAgentCompletionRequest,+ runAgentCompletion,+ )+import Seihou.CLI.AgentLaunch+ ( AgentContext (..),+ BaselineStatus (..),+ formatAvailableModules,+ formatBaselineStatus,+ formatLocalModules,+ formatManifestState,+ formatModuleDhallState,+ formatReferenceFiles,+ formatReferenceFilesDir,+ formatSeihouProjectState,+ gatherAgentContext,+ resolveBlueprintTools,+ substitute,+ )+import Seihou.CLI.AgentLaunchExec (launchConfiguredAgentAddingDirs)+import Seihou.CLI.AppliedBlueprint (recordAppliedBlueprint)+import Seihou.CLI.Commands (BlueprintRunOpts (..))+import Seihou.CLI.Shared+ ( deriveNamespace,+ formatVarError,+ logIO,+ toVarNameMap,+ unwrapConfig,+ )+import Seihou.Composition.Instance (ModuleInstance (..), primaryInstance, qualifiedName)+import Seihou.Composition.Plan (compileComposedPlan)+import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts)+import Seihou.Core.Context (resolveContext)+import Seihou.Core.Module (defaultSearchPaths, discoverRunnable)+import Seihou.Core.Types+import Seihou.Effect.ConfigReader+ ( readContextConfig,+ readGlobalConfig,+ readLocalConfig,+ readNamespaceConfig,+ )+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Effect.ConsoleInterp (runConsole)+import Seihou.Effect.Filesystem (createDirectoryIfMissing)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.Logger (logError, logInfo)+import Seihou.Effect.ManifestStore (readManifest, writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Engine.Conflict (resolveConflicts)+import Seihou.Engine.Diff (computeDiff)+import Seihou.Engine.Execute (executePlan)+import Seihou.Manifest.Types (currentManifestVersion, emptyManifest)+import Seihou.Prelude+import System.Directory (doesDirectoryExist, makeAbsolute)+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..), exitFailure, exitWith)+import System.FilePath (takeDirectory, (</>))++-- | The prompt template, embedded at compile time from data/blueprint-prompt.md.+promptTemplate :: Text+promptTemplate = TE.decodeUtf8 $(embedFile "data/blueprint-prompt.md")++handleAgentRun :: Bool -> AgentModelConfig -> BlueprintRunOpts -> IO ()+handleAgentRun debug modelConfig opts = do+ let level = if opts.runBlueprintVerbose then LogVerbose else LogNormal++ -- (a) Discover and validate. discoverRunnable resolves by directory+ -- name (priority: module > recipe > blueprint).+ searchPaths <- defaultSearchPaths+ runnableResult <- discoverRunnable searchPaths opts.runBlueprintName+ (bp, blueprintDir) <- case runnableResult of+ Right (RunnableBlueprint b dir) -> pure (b, dir)+ Right (RunnableModule _ _) ->+ exitErr level $+ "'"+ <> opts.runBlueprintName.unModuleName+ <> "' is a module, not a blueprint. Did you mean 'seihou run "+ <> opts.runBlueprintName.unModuleName+ <> "'?"+ Right (RunnableRecipe _ _) ->+ exitErr level $+ "'"+ <> opts.runBlueprintName.unModuleName+ <> "' is a recipe, not a blueprint. Did you mean 'seihou run "+ <> opts.runBlueprintName.unModuleName+ <> "'?"+ Left err -> exitErr level (renderModuleLoadError err)++ let filesDir = blueprintDir </> "files"+ providerCanMountFiles =+ modelConfig.agentProvider == AgentProviderClaudeCli+ || modelConfig.agentProvider == AgentProviderCodexCli+ filesExist <- doesDirectoryExist filesDir+ mFilesDir <-+ if filesExist && providerCanMountFiles+ then Just <$> makeAbsolute filesDir+ else pure Nothing++ -- (b) Resolve blueprint variables. Wrap the blueprint's vars/prompts+ -- in a placeholder Module so 'resolveWithPrompts' can run the+ -- standard precedence chain (CLI > env > local > namespace > context+ -- > global > defaults > interactive prompts).+ let placeholderModule =+ Module+ { name = bp.name,+ version = bp.version,+ description = bp.description,+ vars = bp.vars,+ exports = [],+ prompts = bp.prompts,+ steps = [],+ commands = [],+ dependencies = [],+ removal = Nothing,+ migrations = []+ }+ placeholderInst = primaryInstance bp.name+ placeholderTriple = (placeholderInst, placeholderModule, blueprintDir)++ envPairs <- getEnvironment+ let cliOverrides = Map.fromList [(VarName k, v) | (k, v) <- opts.runBlueprintVars]+ envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]+ namespace = fromMaybe (deriveNamespace bp.name) opts.runBlueprintNamespace+ context <- resolveContext opts.runBlueprintContext envVars+ let contextName = fromMaybe "" context++ resolveResult <- runEff $ runConfigReader $ runConsole $ do+ localCfg <- readLocalConfig >>= unwrapConfig level+ nsCfg <- readNamespaceConfig namespace >>= unwrapConfig level+ ctxCfg <- readContextConfig contextName >>= unwrapConfig level+ gCfg <- readGlobalConfig >>= unwrapConfig level+ resolveWithPrompts+ [placeholderTriple]+ cliOverrides+ envVars+ namespace+ contextName+ (toVarNameMap localCfg)+ (toVarNameMap nsCfg)+ (toVarNameMap ctxCfg)+ (toVarNameMap gCfg)++ resolved <- case resolveResult of+ Left errs -> do+ logIO level $ logError "Error resolving blueprint variables:"+ mapM_ (logIO level . logError . (" " <>) . formatVarError) errs+ exitFailure+ Right r -> pure (Map.findWithDefault Map.empty placeholderInst r)++ -- (c) Baseline.+ baseline <-+ if opts.runBlueprintNoBaseline+ then pure BaselineSkipped+ else+ if null bp.baseModules+ then pure BaselineEmpty+ else applyBaseline level opts bp.baseModules cliOverrides resolved++ -- (d) Render the user prompt: substitute resolved vars into bp.prompt.+ let renderedUser = renderUserPrompt resolved bp.prompt++ -- (e) Render the system prompt around the user body.+ ctx <- gatherAgentContext+ let systemPrompt = renderSystemPrompt ctx bp baseline mFilesDir renderedUser++ -- (f) Launch.+ launchSucceeded <-+ runRenderedAgentPrompt+ debug+ modelConfig+ (resolveBlueprintTools bp.allowedTools)+ mFilesDir+ systemPrompt+ opts.runBlueprintPrompt++ -- (g) Record the applied-blueprint provenance into+ -- .seihou/manifest.json only after a successful provider response. In+ -- debug mode, keep the previous successful dry-launch behavior by recording+ -- after the rendered prompt is printed successfully.+ when launchSucceeded $ do+ now <- getCurrentTime+ let entry = appliedBlueprintFromOutcome bp baseline opts now+ manifestPath = ".seihou" </> "manifest.json"+ writeRes <- recordAppliedBlueprint manifestPath entry+ case writeRes of+ Right () -> pure ()+ Left err ->+ logIO level $+ logError $+ "Warning: agent succeeded but recording the applied-blueprint entry failed: "+ <> err++runRenderedAgentPrompt :: Bool -> AgentModelConfig -> [String] -> Maybe FilePath -> Text -> Maybe Text -> IO Bool+runRenderedAgentPrompt debug modelConfig tools mFilesDir systemPrompt initialPrompt+ | debug = do+ TIO.putStr systemPrompt+ pure True+ | modelConfig.agentProvider == AgentProviderClaudeCli || modelConfig.agentProvider == AgentProviderCodexCli = do+ exitCode <-+ launchConfiguredAgentAddingDirs+ (maybeToList mFilesDir)+ modelConfig+ tools+ debug+ systemPrompt+ initialPrompt+ case exitCode of+ ExitSuccess -> pure True+ ExitFailure _ -> exitWith exitCode+ | otherwise = do+ result <- runAgentCompletion (buildAgentCompletionRequest modelConfig systemPrompt initialPrompt)+ case result of+ Right assistantText -> do+ TIO.putStrLn assistantText+ pure True+ Left err -> do+ TIO.putStrLn $ "Error: " <> err+ exitFailure++-- | Project the runner's local state into the persistent+-- 'AppliedBlueprint' shape. Pure so the manifest writer remains a+-- one-liner at the call site and so cross-plan tests can drive it+-- with synthetic inputs.+appliedBlueprintFromOutcome ::+ Blueprint -> BaselineStatus -> BlueprintRunOpts -> UTCTime -> AppliedBlueprint+appliedBlueprintFromOutcome bp baseline opts now =+ AppliedBlueprint+ { name = bp.name,+ blueprintVersion = bp.version,+ appliedAt = now,+ baselineModules = case baseline of+ BaselineApplied entries -> map fst entries+ BaselineEmpty -> []+ BaselineSkipped -> [],+ noBaseline = case baseline of+ BaselineSkipped -> True+ _ -> False,+ userPrompt = opts.runBlueprintPrompt,+ agentSessionId = Nothing+ }++-- | Apply the blueprint's @baseModules@ to the cwd. Mirrors the+-- composition pipeline in @Seihou.CLI.Run.handleRun@: load every+-- declared base module (plus transitive deps), resolve their variables+-- through the same precedence chain (with the blueprint's own resolved+-- vars folded into the CLI override map so the agent's prompt and the+-- base modules see the same values), compile the composed plan,+-- compute the diff, resolve conflicts, execute the plan, and write the+-- resulting manifest. Returns 'BaselineApplied' listing each module's+-- (name, version) for the prompt's "Baseline" section.+applyBaseline ::+ LogLevel ->+ BlueprintRunOpts ->+ [Dependency] ->+ Map VarName Text ->+ Map VarName ResolvedVar ->+ IO BaselineStatus+applyBaseline level opts baseModules cliOverridesIn resolvedBlueprintVars = do+ searchPaths <- defaultSearchPaths+ (primary, additionals) <- case baseModules of+ d : rs -> pure (d.depModule, map (.depModule) rs)+ [] -> exitErr level "internal error: applyBaseline called with empty baseModules"+ compositionResult <- loadComposition searchPaths primary additionals+ modulesInOrder <- case compositionResult of+ Left err -> do+ logIO level $ logError $ "Baseline error: " <> renderModuleLoadError err+ exitFailure+ Right ms -> pure ms++ -- Fold the blueprint's resolved vars into the CLI override map for+ -- the base modules. CLI overrides (already present in cliOverridesIn)+ -- win over blueprint values, mirroring 'seihou run' semantics.+ let blueprintAsOverrides =+ Map.fromList+ [(vn, varValueToText rv.value) | (vn, rv) <- Map.toList resolvedBlueprintVars]+ cliOverrides = Map.union cliOverridesIn blueprintAsOverrides++ envPairs <- getEnvironment+ let envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]+ namespace = fromMaybe (deriveNamespace primary) opts.runBlueprintNamespace+ context <- resolveContext opts.runBlueprintContext envVars+ let contextName = fromMaybe "" context++ baseResolveResult <- runEff $ runConfigReader $ runConsole $ do+ localCfg <- readLocalConfig >>= unwrapConfig level+ nsCfg <- readNamespaceConfig namespace >>= unwrapConfig level+ ctxCfg <- readContextConfig contextName >>= unwrapConfig level+ gCfg <- readGlobalConfig >>= unwrapConfig level+ resolveWithPrompts+ modulesInOrder+ cliOverrides+ envVars+ namespace+ contextName+ (toVarNameMap localCfg)+ (toVarNameMap nsCfg)+ (toVarNameMap ctxCfg)+ (toVarNameMap gCfg)++ baseResolved <- case baseResolveResult of+ Left errs -> do+ logIO level $ logError "Error resolving baseline variables:"+ mapM_ (logIO level . logError . (" " <>) . formatVarError) errs+ exitFailure+ Right r -> pure r++ -- Compile the plan.+ let quads =+ [ (inst, m, dir, Map.map (.value) (baseResolved Map.! inst))+ | (inst, m, dir) <- modulesInOrder+ ]+ planResult <- compileComposedPlan quads+ (ops, _warnings, ownerMap) <- case planResult of+ Left errs -> do+ logIO level $ logError "Errors compiling baseline plan:"+ mapM_ (logIO level . logError . (" " <>)) errs+ exitFailure+ Right r -> pure r++ -- Read the manifest, compute the diff, resolve conflicts, execute,+ -- write the manifest. Mirrors Seihou.CLI.Run.handleRun.+ now <- getCurrentTime+ let manifestPath = ".seihou" </> "manifest.json"+ planned =+ [(dest, content, primary, Nothing) | WriteFileOp dest content _ <- ops]+ ++ [(dest, content, mName, Just pOp) | PatchFileOp dest content pOp _ mName <- ops]++ existingRes <- runEff $ runFilesystem $ runManifestStore manifestPath $ do+ createDirectoryIfMissing True (takeDirectory manifestPath)+ readManifest+ manifest <- case existingRes of+ Left err -> do+ logIO level $ logError $ "Error reading manifest: " <> err+ exitFailure+ Right m -> pure (fromMaybe (emptyManifest now) m)++ diff <- runEff $ runFilesystem $ runManifestStore manifestPath $ do+ let composedNames =+ Set.fromList $+ concatMap (\(inst, _, _) -> [inst.instanceModule, qualifiedName inst]) modulesInOrder+ computeDiff manifest composedNames planned++ resolutions <-+ runEff $ runConsole $ resolveConflicts opts.runBlueprintForce diff.conflicts+ case resolutions of+ Nothing -> do+ logIO level $ logError "Baseline conflicts detected (use --force to overwrite):"+ mapM_ (\c -> logIO level (logError (" ! " <> T.pack c.path))) diff.conflicts+ exitFailure+ Just conflictResolved -> do+ let keepRecords =+ Map.fromList+ [ ( c.path,+ case Map.lookup c.path manifest.files of+ Just existing -> existing {hash = c.diskHash, generatedAt = now}+ Nothing ->+ FileRecord+ { hash = c.diskHash,+ moduleName = c.moduleName,+ strategy = Template,+ generatedAt = now+ }+ )+ | (c, KeepCurrent) <- conflictResolved+ ]+ skipPaths = [c.path | (c, Skip) <- conflictResolved]+ excludePaths = Set.fromList (Map.keys keepRecords ++ skipPaths)+ opsForExec = filter (not . opTargetsPath excludePaths) ops++ runEff $ runFilesystem $ runManifestStore manifestPath $ do+ recs <- executePlan "" opsForExec ownerMap primary now++ let orphanedPaths = map (.path) diff.orphaned+ cleanedFiles = foldr Map.delete manifest.files orphanedPaths+ allModuleEntries = updateAllModules manifest.modules modulesInOrder now+ allResolvedVals =+ Map.unions [Map.map (.value) vs | vs <- Map.elems baseResolved]+ newManifest =+ Manifest+ { version = currentManifestVersion,+ genAt = now,+ modules = allModuleEntries,+ vars = Map.union (Map.map varValueToText allResolvedVals) manifest.vars,+ files = Map.unions [recs, keepRecords, cleanedFiles],+ recipe = manifest.recipe,+ blueprint = manifest.blueprint+ }+ writeManifest newManifest++ let nNew = length diff.new+ nMod = length diff.modified+ nUnch = length diff.unchanged+ logIO level $+ logInfo $+ "Baseline applied: "+ <> T.pack (show nNew)+ <> " new, "+ <> T.pack (show nMod)+ <> " modified, "+ <> T.pack (show nUnch)+ <> " unchanged."+ pure $+ BaselineApplied+ [(m.name, m.version) | (_, m, _) <- modulesInOrder]++-- | Stitch the system-prompt template together. Each block in+-- @blueprint-prompt.md@ has a @{{key}}@ placeholder filled here.+renderSystemPrompt :: AgentContext -> Blueprint -> BaselineStatus -> Maybe FilePath -> Text -> Text+renderSystemPrompt ctx bp baseline mFilesDir userPrompt =+ substitute+ [ ("cwd", ctx.cwd),+ ("seihou_project_state", formatSeihouProjectState ctx),+ ("manifest_state", formatManifestState ctx),+ ("module_dhall_state", formatModuleDhallState ctx),+ ("local_modules", formatLocalModules ctx),+ ("available_modules", formatAvailableModules ctx),+ ("blueprint_name", bp.name.unModuleName),+ ("blueprint_version", fromMaybe "(unspecified)" bp.version),+ ("blueprint_description", fromMaybe "(no description)" bp.description),+ ("baseline_status", formatBaselineStatus baseline),+ ("reference_files", formatReferenceFiles bp.files),+ ("reference_files_dir", formatReferenceFilesDir mFilesDir),+ ("user_prompt", userPrompt)+ ]+ promptTemplate++-- | Substitute resolved blueprint variables into the user prompt body.+renderUserPrompt :: Map VarName ResolvedVar -> Text -> Text+renderUserPrompt resolved tpl =+ substitute+ [(vn.unVarName, varValueToText rv.value) | (vn, rv) <- Map.toList resolved]+ tpl++-- | Local copy of @Seihou.CLI.Run.varValueToText@. Kept in sync with the+-- original; if a third caller appears, lift it into Seihou.CLI.Shared.+varValueToText :: VarValue -> Text+varValueToText (VText t) = t+varValueToText (VBool True) = "true"+varValueToText (VBool False) = "false"+varValueToText (VInt n) = T.pack (show n)+varValueToText (VList vs) = T.intercalate "," (map varValueToText vs)++-- | Whether an operation targets a file in the given path set. Local+-- copy of @Seihou.CLI.Run.opTargetsPath@.+opTargetsPath :: Set FilePath -> Operation -> Bool+opTargetsPath paths (WriteFileOp dest _ _) = Set.member dest paths+opTargetsPath paths (PatchFileOp dest _ _ _ _) = Set.member dest paths+opTargetsPath _ _ = False++-- | Merge freshly-composed module instances into the manifest's+-- applied-modules list. Local copy of @Seihou.CLI.Run.updateAllModules@.+updateAllModules ::+ [AppliedModule] ->+ [(ModuleInstance, Module, FilePath)] ->+ UTCTime ->+ [AppliedModule]+updateAllModules existing modulesInOrder now =+ let composedKeys =+ Set.fromList+ [ (inst.instanceModule, inst.instanceParentVars)+ | (inst, _, _) <- modulesInOrder+ ]+ filtered =+ filter (\am -> not (Set.member (am.name, am.parentVars) composedKeys)) existing+ new =+ [ AppliedModule+ { name = inst.instanceModule,+ parentVars = inst.instanceParentVars,+ source = dir,+ moduleVersion = m.version,+ appliedAt = now,+ removal = m.removal+ }+ | (inst, m, dir) <- modulesInOrder+ ]+ in filtered ++ new++-- | Print an error message and exit with code 1.+exitErr :: LogLevel -> Text -> IO a+exitErr level msg = do+ logIO level (logError msg)+ exitFailure++-- | Render a 'ModuleLoadError' for display.+renderModuleLoadError :: ModuleLoadError -> Text+renderModuleLoadError = \case+ ModuleNotFound name searched ->+ "Module '"+ <> name.unModuleName+ <> "' not found. Searched in:\n"+ <> T.intercalate "\n" (map ((" " <>) . T.pack) searched)+ DhallEvalError name msg ->+ "Failed to evaluate '" <> name.unModuleName <> "': " <> msg+ DhallDecodeError name msg ->+ "Failed to decode '" <> name.unModuleName <> "': " <> msg+ ValidationError name msgs ->+ "Validation failed for '"+ <> name.unModuleName+ <> "':\n"+ <> T.intercalate "\n" (map (" " <>) msgs)+ CircularDependency names ->+ "Circular dependency detected: "+ <> T.intercalate " -> " (map (.unModuleName) names)+ MissingSourceFile name path ->+ "Missing source file in '"+ <> name.unModuleName+ <> "': "+ <> T.pack path+ RegistryEvalError path msg ->+ "Failed to evaluate registry at '" <> path <> "': " <> msg
+ src-exe/Seihou/CLI/Assist.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE TemplateHaskell #-}++module Seihou.CLI.Assist+ ( handleAssist,+ )+where++import Data.FileEmbed (embedFile)+import Data.Text.Encoding qualified as TE+import Data.Text.IO qualified as TIO+import Seihou.CLI.AgentCompletion+ ( AgentModelConfig (..),+ AgentProvider (..),+ buildAgentCompletionRequest,+ runAgentCompletion,+ )+import Seihou.CLI.AgentLaunch+ ( AgentContext (..),+ defaultAllowedTools,+ formatAvailableModules,+ formatLocalModules,+ formatManifestState,+ formatModuleDhallState,+ formatSeihouProjectState,+ gatherAgentContext,+ substitute,+ )+import Seihou.CLI.AgentLaunchExec (launchConfiguredAgent)+import Seihou.CLI.Commands (AssistOpts (..))+import Seihou.Prelude+import System.Exit (exitFailure, exitWith)++-- | The prompt template, embedded at compile time from data/assist-prompt.md.+promptTemplate :: Text+promptTemplate = TE.decodeUtf8 $(embedFile "data/assist-prompt.md")++handleAssist :: Bool -> AgentModelConfig -> AssistOpts -> IO ()+handleAssist debug modelConfig assistOpts = do+ ctx <- gatherAgentContext+ let systemPrompt = renderPrompt ctx+ runRenderedAgentPrompt debug modelConfig systemPrompt assistOpts.assistPrompt++renderPrompt :: AgentContext -> Text+renderPrompt ctx =+ substitute+ [ ("cwd", ctx.cwd),+ ("seihou_project_state", formatSeihouProjectState ctx),+ ("manifest_state", formatManifestState ctx),+ ("module_dhall_state", formatModuleDhallState ctx),+ ("local_modules", formatLocalModules ctx),+ ("available_modules", formatAvailableModules ctx)+ ]+ promptTemplate++runRenderedAgentPrompt :: Bool -> AgentModelConfig -> Text -> Maybe Text -> IO ()+runRenderedAgentPrompt debug modelConfig systemPrompt initialPrompt+ | debug = TIO.putStr systemPrompt+ | modelConfig.agentProvider == AgentProviderClaudeCli || modelConfig.agentProvider == AgentProviderCodexCli = do+ exitCode <- launchConfiguredAgent modelConfig defaultAllowedTools debug systemPrompt initialPrompt+ exitWith exitCode+ | otherwise = do+ result <- runAgentCompletion (buildAgentCompletionRequest modelConfig systemPrompt initialPrompt)+ case result of+ Right assistantText -> TIO.putStrLn assistantText+ Left err -> do+ TIO.putStrLn $ "Error: " <> err+ exitFailure
+ src-exe/Seihou/CLI/Bootstrap.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE TemplateHaskell #-}++module Seihou.CLI.Bootstrap+ ( handleBootstrap,+ )+where++import Data.FileEmbed (embedFile)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Text.IO qualified as TIO+import Seihou.CLI.AgentCompletion+ ( AgentModelConfig (..),+ AgentProvider (..),+ buildAgentCompletionRequest,+ runAgentCompletion,+ )+import Seihou.CLI.AgentLaunch+ ( AgentContext (..),+ bootstrapAllowedTools,+ formatAvailableModules,+ formatLocalModules,+ formatManifestState,+ formatModuleDhallState,+ formatSeihouProjectState,+ gatherAgentContext,+ substitute,+ )+import Seihou.CLI.AgentLaunchExec (launchConfiguredAgent)+import Seihou.CLI.Commands (BootstrapOpts (..))+import Seihou.Prelude+import System.Exit (exitFailure, exitWith)++-- | The prompt template, embedded at compile time from data/bootstrap-prompt.md.+promptTemplate :: Text+promptTemplate = TE.decodeUtf8 $(embedFile "data/bootstrap-prompt.md")++handleBootstrap :: Bool -> AgentModelConfig -> BootstrapOpts -> IO ()+handleBootstrap debug modelConfig bootstrapOpts = do+ ctx <- gatherAgentContext+ let systemPrompt = renderPrompt ctx bootstrapOpts+ runRenderedAgentPrompt debug modelConfig systemPrompt bootstrapOpts.bootstrapPrompt++renderPrompt :: AgentContext -> BootstrapOpts -> Text+renderPrompt ctx bootstrapOpts =+ substitute+ [ ("cwd", ctx.cwd),+ ("seihou_project_state", formatSeihouProjectState ctx),+ ("manifest_state", formatManifestState ctx),+ ("module_dhall_state", formatModuleDhallState ctx),+ ("local_modules", formatLocalModules ctx),+ ("available_modules", formatAvailableModules ctx),+ ("bootstrap_mode", bootstrapMode bootstrapOpts)+ ]+ promptTemplate++runRenderedAgentPrompt :: Bool -> AgentModelConfig -> Text -> Maybe Text -> IO ()+runRenderedAgentPrompt debug modelConfig systemPrompt initialPrompt+ | debug = TIO.putStr systemPrompt+ | modelConfig.agentProvider == AgentProviderClaudeCli || modelConfig.agentProvider == AgentProviderCodexCli = do+ exitCode <- launchConfiguredAgent modelConfig bootstrapAllowedTools debug systemPrompt initialPrompt+ exitWith exitCode+ | otherwise = do+ result <- runAgentCompletion (buildAgentCompletionRequest modelConfig systemPrompt initialPrompt)+ case result of+ Right assistantText -> TIO.putStrLn assistantText+ Left err -> do+ TIO.putStrLn $ "Error: " <> err+ exitFailure++bootstrapMode :: BootstrapOpts -> Text+bootstrapMode opts+ | opts.bootstrapRepo =+ T.unlines+ [ "**Mode: Multi-module repository**",+ "",+ "You are bootstrapping a multi-module repository. This means:",+ "- Create a `seihou-registry.dhall` at the repository root",+ "- Organize modules under a `modules/` directory",+ "- Each module gets its own `module.dhall` and `files/` subdirectory",+ "- Modules can declare dependencies on each other",+ "- Add meaningful tags to each registry entry for discoverability",+ "",+ "Start by asking what modules the repository should contain, then create",+ "them one by one before writing the registry file."+ ]+ | otherwise =+ T.unlines+ [ "**Mode: Single module**",+ "",+ "You are bootstrapping a single Seihou module. Ask the user what kind of",+ "project they want to scaffold, then create a complete module with variables,",+ "templates, prompts, and validation."+ ]
+ src-exe/Seihou/CLI/Browse.hs view
@@ -0,0 +1,94 @@+module Seihou.CLI.Browse+ ( handleBrowse,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.BrowseFormat (formatBrowseRegistry, formatBrowseSingleBlueprint, formatBrowseSingleModule, formatBrowseSinglePrompt)+import Seihou.CLI.Commands (BrowseOpts (..))+import Seihou.CLI.Registry.Sync (checkRegistryVersionDrift)+import Seihou.CLI.Shared (logIO)+import Seihou.Core.Install (parseModuleName)+import Seihou.Core.Registry (EntryKind (..), Registry (..), RegistryEntry (..), RepoContents (..), discoverRepoContents)+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalAgentPromptFromFile, evalBlueprintFromFile, evalModuleFromFile, evalRecipeFromFile, evalRegistryFromFile)+import Seihou.Effect.Logger (logError, logWarn)+import Seihou.Prelude+import System.Exit (ExitCode (..), exitFailure)+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readProcessWithExitCode)++handleBrowse :: BrowseOpts -> IO ()+handleBrowse bopts = do+ let source = bopts.browseSource++ withSystemTempDirectory "seihou-browse" $ \tmpDir -> do+ let repoName = parseModuleName source+ cloneDir = tmpDir </> repoName++ -- Shallow clone+ (exitCode, _stdout, stderr) <- readProcessWithExitCode "git" ["clone", "--depth", "1", T.unpack source, cloneDir] ""+ case exitCode of+ ExitFailure _ -> do+ logIO LogNormal $ do+ logError $ "git clone failed for '" <> source <> "'."+ logError $ " " <> T.pack stderr+ exitFailure+ ExitSuccess -> pure ()++ contents <- discoverRepoContents evalRegistryFromFile cloneDir+ case contents of+ EmptyRepo -> do+ logIO LogNormal (logError "repository contains neither seihou-registry.dhall nor module.dhall.")+ exitFailure+ SingleModule rootDir -> do+ let dhallFile = rootDir </> "module.dhall"+ decoded <- evalModuleFromFile dhallFile+ case decoded of+ Left err -> do+ logIO LogNormal (logError $ "failed to load module: " <> T.pack (show err))+ exitFailure+ Right m ->+ TIO.putStr $ formatBrowseSingleModule source m.name.unModuleName m.description+ SingleRecipe rootDir -> do+ let dhallFile = rootDir </> "recipe.dhall"+ decoded <- evalRecipeFromFile dhallFile+ case decoded of+ Left err -> do+ logIO LogNormal (logError $ "failed to load recipe: " <> T.pack (show err))+ exitFailure+ Right r ->+ TIO.putStr $ formatBrowseSingleModule source r.name.unRecipeName r.description+ SingleBlueprint rootDir -> do+ let dhallFile = rootDir </> "blueprint.dhall"+ decoded <- evalBlueprintFromFile dhallFile+ case decoded of+ Left err -> do+ logIO LogNormal (logError $ "failed to load blueprint: " <> T.pack (show err))+ exitFailure+ Right b -> do+ let bpName = case b of Blueprint nm _ _ _ _ _ _ _ _ _ -> nm+ bpDesc = case b of Blueprint _ _ d _ _ _ _ _ _ _ -> d+ TIO.putStr $ formatBrowseSingleBlueprint source bpName.unModuleName bpDesc+ SinglePrompt rootDir -> do+ let dhallFile = rootDir </> "prompt.dhall"+ decoded <- evalAgentPromptFromFile dhallFile+ case decoded of+ Left err -> do+ logIO LogNormal (logError $ "failed to load prompt: " <> T.pack (show err))+ exitFailure+ Right p ->+ TIO.putStr $ formatBrowseSinglePrompt source p.name.unModuleName p.description+ MultiModule registry -> do+ driftWarnings <- checkRegistryVersionDrift cloneDir registry+ logIO LogNormal (mapM_ logWarn driftWarnings)+ let matchTag e = case bopts.browseTag of+ Nothing -> True+ Just tag -> tag `elem` e.tags+ tagged =+ [(ModuleEntry, e) | e <- registry.modules, matchTag e]+ ++ [(RecipeEntry, e) | e <- registry.recipes, matchTag e]+ ++ [(BlueprintEntry, e) | e <- registry.blueprints, matchTag e]+ ++ [(PromptEntry, e) | e <- registry.prompts, matchTag e]+ TIO.putStr $ formatBrowseRegistry source registry tagged bopts.browseTag
+ src-exe/Seihou/CLI/Commands.hs view
@@ -0,0 +1,1782 @@+module Seihou.CLI.Commands+ ( Command (..),+ RunOpts (..),+ RemoveOpts (..),+ VarsOpts (..),+ InstallOpts (..),+ NewModuleOpts (..),+ NewRecipeOpts (..),+ NewBlueprintOpts (..),+ NewPromptOpts (..),+ ValidateOpts (..),+ ValidateBlueprintOpts (..),+ ValidatePromptOpts (..),+ ConfigOpts (..),+ ConfigAction (..),+ ContextAction (..),+ ListOpts (..),+ StatusOpts (..),+ BrowseOpts (..),+ OutdatedOpts (..),+ UpgradeOpts (..),+ MigrateOpts (..),+ SchemaUpgradeOpts (..),+ AgentOpts (..),+ AgentCommand (..),+ AssistOpts (..),+ BootstrapOpts (..),+ SetupOpts (..),+ BlueprintRunOpts (..),+ PromptCommand (..),+ PromptRunOpts (..),+ CompletionsCommand (..),+ ExtensionCommand (..),+ HelpCommand (..),+ KitCommand (..),+ RegistryCommand (..),+ SyncVersionsOpts (..),+ ValidateRegistryOpts (..),+ commandParser,+ opts,+ )+where++import Data.Text qualified as T+import GHC.Generics (Generic)+import Options.Applicative+import Options.Applicative.Help.Pretty (Doc, indent, line, pretty, vsep)+import Seihou.CLI.Extension (ExtensionRunOpts (..))+import Seihou.CLI.Help (HelpCommand, helpCommandParser)+import Seihou.CLI.Kit (KitCommand, kitCommandParser)+import Seihou.CLI.Migrate (MigrateOpts (..))+import Seihou.CLI.Registry (RegistryCommand (..))+import Seihou.CLI.Registry.Sync (SyncVersionsOpts (..))+import Seihou.CLI.Registry.Validate (ValidateRegistryOpts (..))+import Seihou.CLI.Version (seihouVersionWithGit)+import Seihou.Core.Types (ModuleName (..))+import Seihou.Prelude++data Command+ = Init+ | Run RunOpts+ | Remove RemoveOpts+ | Vars VarsOpts+ | Install InstallOpts+ | Status StatusOpts+ | Diff+ | List ListOpts+ | NewModule NewModuleOpts+ | NewRecipe NewRecipeOpts+ | NewBlueprint NewBlueprintOpts+ | NewPrompt NewPromptOpts+ | ValidateModule ValidateOpts+ | ValidateBlueprint ValidateBlueprintOpts+ | ValidatePrompt ValidatePromptOpts+ | Config ConfigOpts+ | Context ContextAction+ | Browse BrowseOpts+ | Outdated OutdatedOpts+ | Upgrade UpgradeOpts+ | Migrate MigrateOpts+ | SchemaUpgrade SchemaUpgradeOpts+ | Registry RegistryCommand+ | Kit KitCommand+ | Agent AgentOpts+ | Prompt PromptCommand+ | Extension ExtensionCommand+ | HelpCmd HelpCommand+ | Completions CompletionsCommand+ deriving stock (Eq, Show, Generic)++data ExtensionCommand+ = ExtensionRun ExtensionRunOpts+ deriving stock (Eq, Show, Generic)++data CompletionsCommand+ = CompletionsBash+ | CompletionsZsh+ | CompletionsFish+ deriving stock (Eq, Show, Generic)++data AgentOpts = AgentOpts+ { agentDebug :: Bool,+ agentProvider :: Maybe Text,+ agentModel :: Maybe Text,+ agentCommand :: AgentCommand+ }+ deriving stock (Eq, Show, Generic)++data AgentCommand+ = AgentAssist AssistOpts+ | AgentBootstrap BootstrapOpts+ | AgentSetup SetupOpts+ | AgentRun BlueprintRunOpts+ deriving stock (Eq, Show, Generic)++data RunOpts = RunOpts+ { runModule :: Maybe ModuleName,+ runAdditional :: [ModuleName],+ runVars :: [(Text, Text)],+ runDryRun :: Bool,+ runDiff :: Bool,+ runForce :: Bool,+ runNoCommands :: Bool,+ runNamespace :: Maybe Text,+ runContext :: Maybe Text,+ runVerbose :: Bool,+ runSavePrompted :: Maybe Bool,+ runConfirmDefaults :: Bool,+ runCommit :: Bool,+ runCommitMessage :: Maybe Text,+ -- | When 'True', a pre-flight pending-migration check that finds+ -- any chain for one of the composed modules will apply that chain+ -- to the project (and the manifest) before the run plan is+ -- computed. When 'False' (the default), pending chains cause+ -- 'seihou run' to refuse with an actionable message and a+ -- non-zero exit, so a user never silently writes new templates+ -- into paths a migration would have moved.+ runWithMigrations :: Bool+ }+ deriving stock (Eq, Show, Generic)++data RemoveOpts = RemoveOpts+ { removeModule :: ModuleName,+ removeDryRun :: Bool,+ removeForce :: Bool,+ removeVerbose :: Bool+ }+ deriving stock (Eq, Show, Generic)++data VarsOpts = VarsOpts+ { varsModule :: Maybe ModuleName,+ varsExplain :: Bool,+ varsVars :: [(Text, Text)],+ varsNamespace :: Maybe Text,+ varsContext :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++data InstallOpts = InstallOpts+ { installSource :: Maybe Text,+ installName :: Maybe Text,+ installModules :: [Text],+ installAll :: Bool+ }+ deriving stock (Eq, Show, Generic)++data NewModuleOpts = NewModuleOpts+ { newModuleName :: Text,+ newModulePath :: Maybe FilePath+ }+ deriving stock (Eq, Show, Generic)++data NewRecipeOpts = NewRecipeOpts+ { newRecipeName :: Text,+ newRecipeModules :: [Text],+ newRecipePath :: Maybe FilePath+ }+ deriving stock (Eq, Show, Generic)++data NewBlueprintOpts = NewBlueprintOpts+ { newBlueprintName :: Text,+ newBlueprintPath :: Maybe FilePath+ }+ deriving stock (Eq, Show, Generic)++data NewPromptOpts = NewPromptOpts+ { newPromptName :: Text,+ newPromptPath :: Maybe FilePath+ }+ deriving stock (Eq, Show, Generic)++data ValidateOpts = ValidateOpts+ { validatePath :: Maybe FilePath,+ validateLint :: Bool+ }+ deriving stock (Eq, Show, Generic)++data ValidateBlueprintOpts = ValidateBlueprintOpts+ { validateBlueprintPath :: Maybe FilePath,+ validateBlueprintLint :: Bool+ }+ deriving stock (Eq, Show, Generic)++data ValidatePromptOpts = ValidatePromptOpts+ { validatePromptPath :: Maybe FilePath,+ validatePromptLint :: Bool+ }+ deriving stock (Eq, Show, Generic)++data ConfigAction+ = ConfigSet Text Text+ | ConfigGet Text+ | ConfigUnset Text+ | ConfigList+ deriving stock (Eq, Show, Generic)++data ConfigOpts = ConfigOpts+ { configAction :: ConfigAction,+ configGlobal :: Bool,+ configNamespace :: Maybe Text,+ configContext :: Maybe Text,+ configEffective :: Bool+ }+ deriving stock (Eq, Show, Generic)++data ContextAction+ = ContextSet (Maybe Text)+ | ContextDefault Text+ | ContextShow+ | ContextClear+ | ContextClearDefault+ deriving stock (Eq, Show, Generic)++data ListOpts = ListOpts+ { listRepo :: Maybe Text,+ listTag :: Maybe Text,+ listModulesOnly :: Bool,+ listRecipesOnly :: Bool,+ listBlueprintsOnly :: Bool,+ listPromptsOnly :: Bool+ }+ deriving stock (Eq, Show, Generic)++data BrowseOpts = BrowseOpts+ { browseSource :: Text,+ browseTag :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++data StatusOpts = StatusOpts+ { statusCheckUpdates :: Bool+ }+ deriving stock (Eq, Show, Generic)++data OutdatedOpts = OutdatedOpts+ { outdatedJson :: Bool+ }+ deriving stock (Eq, Show, Generic)++data UpgradeOpts = UpgradeOpts+ { upgradeModules :: [Text],+ upgradeDryRun :: Bool,+ upgradeJson :: Bool,+ upgradeSkipUnversioned :: Bool,+ -- | If 'True', after each successful per-module upgrade, also run+ -- 'Seihou.CLI.Migrate.runMigrate' against the *current project*+ -- (cwd), if and only if that module is applied locally. Default+ -- 'False'; the unset path emits a one-line advisory pointing the+ -- user at @seihou migrate@ when migrations would be pending.+ upgradeWithMigrations :: Bool+ }+ deriving stock (Eq, Show, Generic)++data SchemaUpgradeOpts = SchemaUpgradeOpts+ { schemaUpgradePath :: Maybe FilePath,+ schemaUpgradeDryRun :: Bool,+ schemaUpgradeAll :: Bool+ }+ deriving stock (Eq, Show, Generic)++data AssistOpts = AssistOpts+ { assistPrompt :: Maybe Text,+ assistProvider :: Maybe Text,+ assistModel :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++data BootstrapOpts = BootstrapOpts+ { bootstrapPrompt :: Maybe Text,+ bootstrapRepo :: Bool,+ bootstrapProvider :: Maybe Text,+ bootstrapModel :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++data SetupOpts = SetupOpts+ { setupPrompt :: Maybe Text,+ setupProvider :: Maybe Text,+ setupModel :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++data BlueprintRunOpts = BlueprintRunOpts+ { runBlueprintName :: ModuleName,+ runBlueprintPrompt :: Maybe Text,+ runBlueprintVars :: [(Text, Text)],+ runBlueprintNoBaseline :: Bool,+ runBlueprintNamespace :: Maybe Text,+ runBlueprintContext :: Maybe Text,+ runBlueprintVerbose :: Bool,+ runBlueprintForce :: Bool,+ runBlueprintProvider :: Maybe Text,+ runBlueprintModel :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++data PromptCommand+ = PromptRun PromptRunOpts+ deriving stock (Eq, Show, Generic)++data PromptRunOpts = PromptRunOpts+ { runPromptName :: ModuleName,+ runPromptPrompt :: Maybe Text,+ runPromptVars :: [(Text, Text)],+ runPromptNamespace :: Maybe Text,+ runPromptContext :: Maybe Text,+ runPromptVerbose :: Bool,+ runPromptDebug :: Bool,+ runPromptProvider :: Maybe Text,+ runPromptModel :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++opts :: ParserInfo Command+opts =+ info+ (commandParser <**> helper <**> version)+ ( fullDesc+ <> progDesc "Composable, type-safe project scaffolding"+ <> header "seihou - composable project scaffolding"+ <> footerDoc (Just topLevelFooter)+ )+ where+ version = infoOption (T.unpack seihouVersionWithGit) (long "version" <> help "Show version")++topLevelFooter :: Doc+topLevelFooter =+ vsep+ [ pretty ("Getting started:" :: String),+ mempty,+ indent 2 $ vsep [pretty ("seihou init" :: String), pretty ("seihou run <module> --var project.name=my-app" :: String), pretty ("seihou status" :: String)],+ mempty,+ pretty ("Learn more:" :: String),+ mempty,+ indent 2 $+ vsep+ [ pretty ("seihou help # list all help topics" :: String),+ pretty ("seihou help modules # how modules work" :: String),+ pretty ("seihou help migrations # apply author-declared migrations between versions" :: String)+ ],+ mempty,+ pretty ("Run 'seihou COMMAND --help' for details on a specific command." :: String)+ ]++commandParser :: Parser Command+commandParser =+ hsubparser+ ( command "init" initInfo+ <> command "run" runInfo+ <> command "remove" removeInfo+ <> command "status" statusInfo+ <> command "diff" diffInfo+ )+ <|> hsubparser+ ( command "list" listInfo+ <> command "install" installInfo+ <> command "browse" browseInfo+ <> command "outdated" outdatedInfo+ <> command "upgrade" upgradeInfo+ <> command "migrate" migrateInfo+ <> commandGroup "Module management:"+ <> hidden+ )+ <|> hsubparser+ ( command "new-module" newModuleInfo+ <> command "new-recipe" newRecipeInfo+ <> command "new-blueprint" newBlueprintInfo+ <> command "new-prompt" newPromptInfo+ <> command "validate-module" validateInfo+ <> command "validate-blueprint" validateBlueprintInfo+ <> command "validate-prompt" validatePromptInfo+ <> command "vars" varsInfo+ <> command "schema-upgrade" schemaUpgradeInfo+ <> command "registry" registryInfo+ <> commandGroup "Authoring:"+ <> hidden+ )+ <|> hsubparser+ ( command "config" configInfo+ <> command "context" contextInfo+ <> commandGroup "Configuration:"+ <> hidden+ )+ <|> hsubparser+ ( command "agent" agentInfo+ <> command "prompt" promptInfo+ <> command "kit" kitInfo+ <> commandGroup "AI agent:"+ <> hidden+ )+ <|> hsubparser+ ( command "help" helpCmdInfo+ <> command "completions" completionsInfo+ <> command "extension" extensionInfo+ <> commandGroup "Help & shell integration:"+ <> hidden+ )++-- Command info blocks++initInfo :: ParserInfo Command+initInfo =+ info+ (pure Init <**> helper)+ ( fullDesc+ <> progDesc "Initialize Seihou configuration"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Creates the Seihou configuration directory at ~/.config/seihou/ with" :: String),+ pretty ("subdirectories for user modules and installed modules. Also writes a" :: String),+ pretty ("default config.dhall. Safe to run multiple times; existing files are" :: String),+ pretty ("left untouched." :: String)+ ]+ )+ )++runInfo :: ParserInfo Command+runInfo =+ info+ (runParser <**> helper)+ ( fullDesc+ <> progDesc "Run modules to generate a project"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Loads the specified module and its dependencies, resolves all variables," :: String),+ pretty ("compiles a generation plan, and executes it in the current directory." :: String),+ line,+ pretty ("Compose multiple modules with -m/--module (repeatable). Override" :: String),+ pretty ("variables with --var KEY=VALUE (repeatable). Use --dry-run to preview" :: String),+ pretty ("the plan without writing files, or --diff to compare against disk." :: String),+ line,+ pretty ("When re-running, Seihou uses the .seihou/manifest.json to detect" :: String),+ pretty ("new, modified, unchanged, and conflicting files. Conflicts are" :: String),+ pretty ("reported and block execution unless --force is used." :: String),+ line,+ pretty ("If an applied module's installed copy has advanced past the manifest's" :: String),+ pretty ("recorded version and ships migrations that move project files," :: String),+ pretty ("'seihou run' refuses to proceed (so it never writes new templates into" :: String),+ pretty ("paths a migration would have moved). Run 'seihou migrate <module>'" :: String),+ pretty ("first, or pass --with-migrations to apply pending chains in-band." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou run haskell-base --var project.name=my-app" :: String),+ pretty ("seihou run haskell-base -m nix-flake --dry-run" :: String),+ pretty ("seihou run my-module --diff" :: String),+ pretty ("seihou run haskell-base --confirm-defaults # review and override default values" :: String),+ pretty ("seihou run haskell-base --with-migrations # apply pending migrations before regenerating" :: String)+ ]+ ]+ )+ )++removeInfo :: ParserInfo Command+removeInfo =+ info+ (removeParser <**> helper)+ ( fullDesc+ <> progDesc "Remove an applied module and delete its generated files"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Removes a module that was previously applied via 'seihou run' and" :: String),+ pretty ("reverses its effects. Only modules with a 'removal' section" :: String),+ pretty ("in their module.dhall can be removed." :: String),+ line,+ pretty ("Files that have been modified since generation are treated as" :: String),+ pretty ("conflicts. Use --force to delete them without prompting, or" :: String),+ pretty ("respond interactively to keep or delete each one." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou remove haskell-base" :: String),+ pretty ("seihou remove haskell-base --dry-run" :: String),+ pretty ("seihou remove haskell-base --force" :: String)+ ]+ ]+ )+ )++removeParser :: Parser Command+removeParser =+ fmap Remove $+ RemoveOpts+ <$> argument moduleNameReader (metavar "MODULE" <> help "Module to remove")+ <*> switch (long "dry-run" <> help "Show removal plan without executing")+ <*> switch (long "force" <> help "Delete conflicted files without prompting")+ <*> switch (long "verbose" <> short 'v' <> help "Show detailed progress messages")++varsInfo :: ParserInfo Command+varsInfo =+ info+ (varsParser <**> helper)+ ( fullDesc+ <> progDesc "Inspect resolved variables"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("By default, lists all variable declarations for the module with their" :: String),+ pretty ("types, defaults, and descriptions." :: String),+ line,+ pretty ("With --explain, resolves variables and shows the provenance of each" :: String),+ pretty ("value (default, CLI override, environment variable, or export from a" :: String),+ pretty ("dependency). Use --var KEY=VALUE to supply context for resolution." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $ vsep [pretty ("seihou vars haskell-base" :: String), pretty ("seihou vars haskell-base --explain --var project.name=my-app" :: String)]+ ]+ )+ )++installInfo :: ParserInfo Command+installInfo =+ info+ (installParser <**> helper)+ ( fullDesc+ <> progDesc "Install module(s), recipe(s), blueprint(s), or prompt(s) from git"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Clones the git repository and installs modules, recipes," :: String),+ pretty ("blueprints, or prompts to ~/.config/seihou/installed/<name>/." :: String),+ line,+ pretty ("If the repository contains a seihou-registry.dhall file, it is" :: String),+ pretty ("treated as a multi-module registry. Use --module to pick specific" :: String),+ pretty ("entries or --all to install everything. Without either flag, you" :: String),+ pretty ("will be prompted to choose interactively." :: String),+ line,+ pretty ("For single-artifact repositories (a root module.dhall, recipe.dhall," :: String),+ pretty ("blueprint.dhall, or prompt.dhall), the artifact name defaults to the repository" :: String),+ pretty ("name. Use --name to override." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou install https://github.com/user/haskell-module.git" :: String),+ pretty ("seihou install https://github.com/user/templates.git --all" :: String),+ pretty ("seihou install https://github.com/user/templates.git --module haskell-base" :: String)+ ]+ ]+ )+ )++statusInfo :: ParserInfo Command+statusInfo =+ info+ (statusParser <**> helper)+ ( fullDesc+ <> progDesc "Show manifest state"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Reads .seihou/manifest.json in the current directory and displays" :: String),+ pretty ("applied modules, tracked files, and resolved variable values." :: String),+ pretty ("If no manifest exists, reports that and exits successfully." :: String),+ line,+ pretty ("Use --check-updates to also report which applied modules have newer" :: String),+ pretty ("versions available from their source repository. This requires network" :: String),+ pretty ("access and will clone each source repo shallowly." :: String),+ line,+ pretty ("When an applied module's installed copy has advanced past the manifest's" :: String),+ pretty ("recorded version, status reports the pending migration count under that" :: String),+ pretty ("module's line; run 'seihou migrate <module>' to apply them." :: String)+ ]+ )+ )++statusParser :: Parser Command+statusParser =+ fmap Status $+ StatusOpts+ <$> switch+ ( long "check-updates"+ <> short 'u'+ <> help "Check installed modules for available updates (requires network)"+ )++diffInfo :: ParserInfo Command+diffInfo =+ info+ (pure Diff <**> helper)+ ( fullDesc+ <> progDesc "Show changes since last generation"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Compares tracked files in .seihou/manifest.json against the current" :: String),+ pretty ("disk state. Shows files that have been modified or deleted since the" :: String),+ pretty ("last 'seihou run'. Does not load modules or resolve variables." :: String)+ ]+ )+ )++listInfo :: ParserInfo Command+listInfo =+ info+ (listParser <**> helper)+ ( fullDesc+ <> progDesc "List available modules, recipes, blueprints, and prompts"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Scans all search paths and lists every available runnable artifact" :: String),+ pretty ("(modules, recipes, blueprints, prompts) with its name, kind, description, and" :: String),+ pretty ("source location (project, user, or installed). Entries that fail to" :: String),+ pretty ("load are shown with an error indicator." :: String),+ line,+ pretty ("Use --repo and --tag to filter the output." :: String),+ pretty ("Use --modules, --recipes, --blueprints, and --prompts to restrict by kind" :: String),+ pretty ("(combine them to show several kinds; omit all to show every kind)." :: String)+ ]+ )+ )++listParser :: Parser Command+listParser =+ fmap List $+ ListOpts+ <$> optional (option (T.pack <$> str) (long "repo" <> metavar "REPO" <> help "Filter by repository name"))+ <*> optional (option (T.pack <$> str) (long "tag" <> metavar "TAG" <> help "Filter by tag"))+ <*> switch (long "modules" <> help "Show only modules")+ <*> switch (long "recipes" <> help "Show only recipes")+ <*> switch (long "blueprints" <> help "Show only blueprints")+ <*> switch (long "prompts" <> help "Show only prompts")++newModuleInfo :: ParserInfo Command+newModuleInfo =+ info+ (newModuleParser <**> helper)+ ( fullDesc+ <> progDesc "Scaffold a new module"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Creates a new module directory with a boilerplate module.dhall and an" :: String),+ pretty ("example template file at files/README.md.tpl. The output directory" :: String),+ pretty ("defaults to ./<name>/ in the current directory." :: String),+ line,+ pretty ("Module names must match [a-z][a-z0-9-]* (lowercase, hyphens allowed," :: String),+ pretty ("must start with a letter)." :: String),+ line,+ pretty ("Example:" :: String),+ indent 2 $ pretty ("seihou new-module my-template --path ~/modules/my-template" :: String)+ ]+ )+ )++validateInfo :: ParserInfo Command+validateInfo =+ info+ (validateParser <**> helper)+ ( fullDesc+ <> progDesc "Validate a module"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Checks that a module directory is well-formed: module.dhall exists and" :: String),+ pretty ("evaluates, the module name is valid, variable names are unique, prompts" :: String),+ pretty ("reference declared variables, step source files exist, and exports" :: String),+ pretty ("reference declared variables." :: String),+ line,+ pretty ("PATH defaults to the current directory if not specified." :: String),+ line,+ pretty ("Example:" :: String),+ indent 2 $ pretty ("seihou validate-module ./my-module" :: String)+ ]+ )+ )++configInfo :: ParserInfo Command+configInfo =+ info+ (configParser <**> helper)+ ( fullDesc+ <> progDesc "Read and write config values"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Manage config values across local, namespace, and global scopes." :: String),+ pretty ("Default scope is local (.seihou/config.dhall). Use --global or" :: String),+ pretty ("--namespace NS for other scopes." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou config set project.name my-app" :: String),+ pretty ("seihou config get project.name" :: String),+ pretty ("seihou config list" :: String),+ pretty ("seihou config set license MIT --global" :: String),+ pretty ("seihou config unset license --global" :: String),+ pretty ("seihou config list --namespace haskell" :: String)+ ]+ ]+ )+ )++-- Subparsers++runParser :: Parser Command+runParser =+ fmap Run $+ RunOpts+ <$> optional (argument moduleNameReader (metavar "MODULE"))+ <*> many+ ( option+ moduleNameReader+ (long "module" <> short 'm' <> metavar "MODULE" <> help "Additional module to compose (repeatable)")+ )+ <*> many+ ( option+ varPair+ (long "var" <> metavar "KEY=VALUE" <> help "Variable override (repeatable)")+ )+ <*> switch (long "dry-run" <> help "Show plan without executing")+ <*> switch (long "diff" <> help "Show diff against current disk state")+ <*> switch (long "force" <> help "Auto-resolve conflicts (accept new files)")+ <*> switch (long "no-commands" <> help "Skip shell command steps")+ <*> optional (option (T.pack <$> str) (long "namespace" <> metavar "NS" <> help "Override namespace for config lookup"))+ <*> optional (option (T.pack <$> str) (long "context" <> short 'c' <> metavar "CTX" <> help "Override context for config lookup"))+ <*> switch (long "verbose" <> short 'v' <> help "Show detailed progress messages")+ <*> optional+ ( flag' True (long "save-prompted" <> help "Save prompted values to local config without asking")+ <|> flag' False (long "no-save-prompted" <> help "Do not offer to save prompted values")+ )+ <*> switch (long "confirm-defaults" <> help "Step through default values and confirm or override each one")+ <*> switch (long "commit" <> help "Commit generated files to git after execution (uses AI-generated message)")+ <*> optional (option (T.pack <$> str) (long "commit-message" <> metavar "MSG" <> help "Custom commit message (implies --commit)"))+ <*> switch+ ( long "with-migrations"+ <> help "Apply any pending module migrations before the run plan; without this, 'seihou run' refuses when migrations are pending"+ )++varsParser :: Parser Command+varsParser =+ fmap Vars $+ VarsOpts+ <$> optional (argument moduleNameReader (metavar "MODULE"))+ <*> switch (long "explain" <> help "Show resolved values with provenance")+ <*> many+ ( option+ varPair+ (long "var" <> metavar "KEY=VALUE" <> help "Provide variable values for resolution (repeatable)")+ )+ <*> optional (option (T.pack <$> str) (long "namespace" <> metavar "NS" <> help "Override namespace for config lookup"))+ <*> optional (option (T.pack <$> str) (long "context" <> short 'c' <> metavar "CTX" <> help "Override context for config lookup"))++installParser :: Parser Command+installParser =+ fmap Install $+ InstallOpts+ <$> optional (argument (T.pack <$> str) (metavar "GIT-URL"))+ <*> optional (option (T.pack <$> str) (long "name" <> metavar "NAME" <> help "Override installed module name"))+ <*> many (option (T.pack <$> str) (long "module" <> metavar "MODULE" <> help "Module, recipe, blueprint, or prompt name from the registry to install (repeatable)"))+ <*> switch (long "all" <> help "Install every module, recipe, blueprint, and prompt listed in the registry")++newModuleParser :: Parser Command+newModuleParser =+ fmap NewModule $+ NewModuleOpts+ <$> argument (T.pack <$> str) (metavar "NAME")+ <*> optional (option str (long "path" <> metavar "DIR" <> help "Output directory (default: ./<name>/)"))++newRecipeInfo :: ParserInfo Command+newRecipeInfo =+ info+ (newRecipeParser <**> helper)+ ( fullDesc+ <> progDesc "Scaffold a new recipe"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Creates a new recipe directory with a boilerplate recipe.dhall." :: String),+ pretty ("The output directory defaults to ./<name>/ in the current directory." :: String),+ line,+ pretty ("Recipe names must match [a-z][a-z0-9-]* (lowercase, hyphens allowed," :: String),+ pretty ("must start with a letter)." :: String),+ line,+ pretty ("Example:" :: String),+ indent 2 $ pretty ("seihou new-recipe haskell-library --module nix-flake --module cabal-ghc" :: String)+ ]+ )+ )++newRecipeParser :: Parser Command+newRecipeParser =+ fmap NewRecipe $+ NewRecipeOpts+ <$> argument (T.pack <$> str) (metavar "NAME")+ <*> many (option (T.pack <$> str) (long "module" <> short 'm' <> metavar "MODULE" <> help "Module to include in the recipe"))+ <*> optional (option str (long "path" <> metavar "DIR" <> help "Output directory (default: ./<name>/)"))++validateParser :: Parser Command+validateParser =+ fmap ValidateModule $+ ValidateOpts+ <$> optional (argument str (metavar "PATH"))+ <*> switch (long "lint" <> help "Include advisory lint warnings")++newBlueprintInfo :: ParserInfo Command+newBlueprintInfo =+ info+ (newBlueprintParser <**> helper)+ ( fullDesc+ <> progDesc "Scaffold a new agent-driven blueprint"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Creates a new blueprint directory containing three artifacts:" :: String),+ indent 2 $+ vsep+ [ pretty ("blueprint.dhall the blueprint record (imports the schema)" :: String),+ pretty ("prompt.md the Markdown body the agent runner consumes" :: String),+ pretty ("files/ empty reference directory for snippets, templates" :: String)+ ],+ line,+ pretty ("The output directory defaults to ./<name>/ in the current directory." :: String),+ line,+ pretty ("Blueprint names must match [a-z][a-z0-9-]* (lowercase, hyphens allowed," :: String),+ pretty ("must start with a letter)." :: String),+ line,+ pretty ("Example:" :: String),+ indent 2 $ pretty ("seihou new-blueprint payments-service" :: String)+ ]+ )+ )++newBlueprintParser :: Parser Command+newBlueprintParser =+ fmap NewBlueprint $+ NewBlueprintOpts+ <$> argument (T.pack <$> str) (metavar "NAME")+ <*> optional (option str (long "path" <> metavar "DIR" <> help "Output directory (default: ./<name>/)"))++newPromptInfo :: ParserInfo Command+newPromptInfo =+ info+ (newPromptParser <**> helper)+ ( fullDesc+ <> progDesc "Scaffold a new agent-session prompt"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Creates a new prompt directory containing three artifacts:" :: String),+ indent 2 $+ vsep+ [ pretty ("prompt.dhall the prompt record" :: String),+ pretty ("prompt.md the Markdown body rendered before launch" :: String),+ pretty ("files/ empty reference directory for snippets and docs" :: String)+ ],+ line,+ pretty ("The output directory defaults to ./<name>/ in the current directory." :: String),+ line,+ pretty ("Prompt names must match [a-z][a-z0-9-]* (lowercase, hyphens allowed," :: String),+ pretty ("must start with a letter)." :: String),+ line,+ pretty ("Example:" :: String),+ indent 2 $ pretty ("seihou new-prompt review-changes" :: String)+ ]+ )+ )++newPromptParser :: Parser Command+newPromptParser =+ fmap NewPrompt $+ NewPromptOpts+ <$> argument (T.pack <$> str) (metavar "NAME")+ <*> optional (option str (long "path" <> metavar "DIR" <> help "Output directory (default: ./<name>/)"))++validateBlueprintInfo :: ParserInfo Command+validateBlueprintInfo =+ info+ (validateBlueprintParser <**> helper)+ ( fullDesc+ <> progDesc "Validate a blueprint"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Checks that a blueprint directory is well-formed: blueprint.dhall" :: String),+ pretty ("evaluates, the blueprint name is valid, the prompt body is non-empty," :: String),+ pretty ("variable names are unique, prompts reference declared variables," :: String),+ pretty ("every entry in the files list resolves under files/, and base modules" :: String),+ pretty ("are not themselves blueprints." :: String),+ line,+ pretty ("PATH defaults to the current directory if not specified." :: String),+ line,+ pretty ("Example:" :: String),+ indent 2 $ pretty ("seihou validate-blueprint ./payments-service" :: String)+ ]+ )+ )++validateBlueprintParser :: Parser Command+validateBlueprintParser =+ fmap ValidateBlueprint $+ ValidateBlueprintOpts+ <$> optional (argument str (metavar "PATH"))+ <*> switch (long "lint" <> help "Include advisory lint warnings")++validatePromptInfo :: ParserInfo Command+validatePromptInfo =+ info+ (validatePromptParser <**> helper)+ ( fullDesc+ <> progDesc "Validate a prompt"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Checks that a prompt directory is well-formed: prompt.dhall" :: String),+ pretty ("evaluates, the prompt name is valid, the prompt body is non-empty," :: String),+ pretty ("variable names are unique, prompts reference declared variables," :: String),+ pretty ("command variables are well-formed, and every entry in files resolves" :: String),+ pretty ("under files/." :: String),+ line,+ pretty ("PATH defaults to the current directory if not specified." :: String),+ line,+ pretty ("Example:" :: String),+ indent 2 $ pretty ("seihou validate-prompt ./review-changes" :: String)+ ]+ )+ )++validatePromptParser :: Parser Command+validatePromptParser =+ fmap ValidatePrompt $+ ValidatePromptOpts+ <$> optional (argument str (metavar "PATH"))+ <*> switch (long "lint" <> help "Include advisory lint warnings")++configParser :: Parser Command+configParser =+ fmap Config $+ ConfigOpts+ <$> configActionParser+ <*> switch (long "global" <> short 'g' <> help "Use global scope (~/.config/seihou/config.dhall)")+ <*> optional (option (T.pack <$> str) (long "namespace" <> short 'n' <> metavar "NS" <> help "Use namespace scope"))+ <*> optional (option (T.pack <$> str) (long "context" <> short 'c' <> metavar "CTX" <> help "Use context scope"))+ <*> switch (long "effective" <> short 'e' <> help "Show merged config across all scopes (with list)")++configActionParser :: Parser ConfigAction+configActionParser =+ subparser+ ( command "set" (info configSetParser (progDesc "Set a config value"))+ <> command "get" (info configGetParser (progDesc "Get a config value"))+ <> command "unset" (info configUnsetParser (progDesc "Remove a config value"))+ <> command "list" (info (pure ConfigList) (progDesc "List config values"))+ )++configSetParser :: Parser ConfigAction+configSetParser =+ ConfigSet+ <$> argument (T.pack <$> str) (metavar "KEY")+ <*> argument (T.pack <$> str) (metavar "VALUE")++configGetParser :: Parser ConfigAction+configGetParser = ConfigGet <$> argument (T.pack <$> str) (metavar "KEY")++configUnsetParser :: Parser ConfigAction+configUnsetParser = ConfigUnset <$> argument (T.pack <$> str) (metavar "KEY")++contextInfo :: ParserInfo Command+contextInfo =+ info+ (contextParser <**> helper)+ ( fullDesc+ <> progDesc "Manage the active context (work, personal, etc.)"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Contexts allow variables like user.email to resolve differently" :: String),+ pretty ("depending on whether you're working in a 'work' or 'personal'" :: String),+ pretty ("context. Context config files live at" :: String),+ pretty ("~/.config/seihou/contexts/<name>/config.dhall." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou context show # show active context" :: String),+ pretty ("seihou context set work # set project context" :: String),+ pretty ("seihou context default personal # set global default" :: String),+ pretty ("seihou context clear # remove project context" :: String),+ pretty ("seihou context clear-default # remove global default" :: String)+ ]+ ]+ )+ )++contextParser :: Parser Command+contextParser =+ fmap Context $+ subparser+ ( command "show" (info (pure ContextShow) (progDesc "Show the active context and its source"))+ <> command "set" (info (ContextSet <$> optional (argument (T.pack <$> str) (metavar "NAME"))) (progDesc "Set the project context (.seihou/context)"))+ <> command "default" (info (ContextDefault <$> argument (T.pack <$> str) (metavar "NAME")) (progDesc "Set the global default context (~/.config/seihou/default-context)"))+ <> command "clear" (info (pure ContextClear) (progDesc "Remove the project context file"))+ <> command "clear-default" (info (pure ContextClearDefault) (progDesc "Remove the global default context"))+ )++browseInfo :: ParserInfo Command+browseInfo =+ info+ (browseParser <**> helper)+ ( fullDesc+ <> progDesc "Browse modules, recipes, blueprints, and prompts in a git repository"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Clones the repository and shows available modules, recipes," :: String),+ pretty ("blueprints, and prompts without installing anything. For multi-artifact repos" :: String),+ pretty ("with a seihou-registry.dhall, displays all entries with descriptions," :: String),+ pretty ("kind labels, and tags. Use --tag to filter by tag." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou browse https://github.com/user/templates.git" :: String),+ pretty ("seihou browse https://github.com/user/templates.git --tag haskell" :: String)+ ]+ ]+ )+ )++browseParser :: Parser Command+browseParser =+ fmap Browse $+ BrowseOpts+ <$> argument (T.pack <$> str) (metavar "GIT-URL")+ <*> optional (option (T.pack <$> str) (long "tag" <> metavar "TAG" <> help "Filter modules by tag"))++outdatedInfo :: ParserInfo Command+outdatedInfo =+ info+ (outdatedParser <**> helper)+ ( fullDesc+ <> progDesc "Check installed modules for newer versions"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Checks each installed module's source registry for a newer version." :: String),+ pretty ("Modules without version information are shown as 'unversioned'." :: String),+ pretty ("Only modules installed via 'seihou install' are checked." :: String),+ line,+ pretty ("Example:" :: String),+ indent 2 $ pretty ("seihou outdated" :: String),+ line,+ pretty ("Run 'seihou upgrade' to apply available updates. If a module ships" :: String),+ pretty ("migrations, 'seihou upgrade' will surface them via an advisory; run" :: String),+ pretty ("'seihou migrate <module>' (or 'seihou upgrade --with-migrations')" :: String),+ pretty ("to apply them to the current project." :: String)+ ]+ )+ )++outdatedParser :: Parser Command+outdatedParser =+ fmap Outdated $+ OutdatedOpts+ <$> switch (long "json" <> help "Output as JSON")++upgradeInfo :: ParserInfo Command+upgradeInfo =+ info+ (upgradeParser <**> helper)+ ( fullDesc+ <> progDesc "Upgrade installed modules to latest versions"+ <> footerDoc (Just upgradeFooter)+ )++upgradeParser :: Parser Command+upgradeParser =+ fmap Upgrade $+ UpgradeOpts+ <$> many (argument (T.pack <$> str) (metavar "MODULE" <> help "Module(s) to upgrade (default: all)"))+ <*> switch (long "dry-run" <> help "Show what would be upgraded without making changes")+ <*> switch (long "json" <> help "Output as JSON")+ <*> switch (long "skip-unversioned" <> help "Skip modules without version information")+ <*> switch+ ( long "with-migrations"+ <> help "After each upgrade, also run 'seihou migrate' against the current project for that module"+ )++upgradeFooter :: Doc+upgradeFooter =+ vsep+ [ pretty ("Upgrades installed modules to the latest version available from their" :: String),+ pretty ("source repository. Only modules installed via 'seihou install' are checked." :: String),+ pretty ("Modules without version information are upgraded by default." :: String),+ pretty ("Use --skip-unversioned to skip them." :: String),+ line,+ pretty ("With no arguments, checks all installed modules. Pass module names to" :: String),+ pretty ("upgrade specific modules only." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou upgrade # upgrade all installed modules" :: String),+ pretty ("seihou upgrade haskell-base # upgrade a specific module" :: String),+ pretty ("seihou upgrade --dry-run # preview without changes" :: String),+ pretty ("seihou upgrade --skip-unversioned # skip unversioned modules" :: String),+ pretty ("seihou upgrade --with-migrations # also run 'seihou migrate' for each upgrade" :: String)+ ],+ line,+ pretty ("Migrations:" :: String),+ indent 2 $+ vsep+ [ pretty ("Newer module versions may declare migrations that move project files" :: String),+ pretty ("when applied. By default 'seihou upgrade' does not run them — it only" :: String),+ pretty ("prints an advisory pointing at 'seihou migrate <module>'. Pass" :: String),+ pretty ("--with-migrations to run them as part of the upgrade." :: String)+ ]+ ]++migrateInfo :: ParserInfo Command+migrateInfo =+ info+ (migrateParser <**> helper)+ ( fullDesc+ <> progDesc "Apply module-declared migrations to the current project"+ <> footerDoc (Just migrateFooter)+ )++migrateParser :: Parser Command+migrateParser =+ fmap Migrate $+ MigrateOpts+ <$> argument (ModuleName . T.pack <$> str) (metavar "MODULE" <> help "The applied module to migrate")+ <*> optional+ ( option+ (T.pack <$> str)+ ( long "to"+ <> metavar "VERSION"+ <> help "Target version (default: installed module's current version)"+ )+ )+ <*> switch (long "dry-run" <> help "Show the migration plan without modifying any files")+ <*> switch (long "force" <> help "Proceed even when files have been edited since generation")+ <*> switch (long "json" <> help "Emit the plan as JSON instead of human-readable text")+ <*> switch (long "verbose" <> short 'v' <> help "Print extra detail about each operation")+ <*> switch (long "no-fetch" <> help "Skip the remote fetch; use only the locally installed copy")+ <*> switch (long "commit" <> help "Commit migrated files to git after execution (uses AI-generated message)")+ <*> optional (option (T.pack <$> str) (long "commit-message" <> metavar "MSG" <> help "Custom commit message (implies --commit)"))++migrateFooter :: Doc+migrateFooter =+ vsep+ [ pretty ("Applies the migrations declared on a module's module.dhall file to the" :: String),+ pretty ("current project's working tree and manifest at .seihou/manifest.json." :: String),+ pretty ("The chain that runs is determined by the manifest's recorded version" :: String),+ pretty ("of the applied module (the 'from') and either the installed copy's" :: String),+ pretty ("current version or a --to override (the 'to')." :: String),+ line,+ pretty ("Available migration operations:" :: String),+ indent 2 $+ vsep+ [ pretty ("MoveFile rename a single tracked file" :: String),+ pretty ("MoveDir rename a directory; rewrites every contained manifest entry" :: String),+ pretty ("DeleteFile remove a tracked file" :: String),+ pretty ("DeleteDir recursively remove a directory" :: String),+ pretty ("RunCommand run a shell command (escape hatch; manifest is not auto-updated)" :: String)+ ],+ line,+ pretty ("Conflict semantics mirror 'seihou remove': files whose disk hash differs" :: String),+ pretty ("from the manifest are flagged. Without --force the engine refuses to" :: String),+ pretty ("overwrite them and exits non-zero. With --force, the migration proceeds." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou migrate haskell-base # plan + apply" :: String),+ pretty ("seihou migrate haskell-base --dry-run # preview only" :: String),+ pretty ("seihou migrate haskell-base --to 1.5.0 # stop at intermediate version" :: String),+ pretty ("seihou migrate haskell-base --force # overwrite conflicted files" :: String),+ pretty ("seihou migrate haskell-base --json # machine-readable plan" :: String),+ pretty ("seihou migrate haskell-base --commit # auto-commit after migrate" :: String)+ ],+ line,+ pretty ("See also: seihou help migrations" :: String)+ ]++schemaUpgradeInfo :: ParserInfo Command+schemaUpgradeInfo =+ info+ (schemaUpgradeParser <**> helper)+ ( fullDesc+ <> progDesc "Upgrade module.dhall files to the current schema"+ <> footerDoc (Just schemaUpgradeFooter)+ )++schemaUpgradeParser :: Parser Command+schemaUpgradeParser =+ fmap SchemaUpgrade $+ SchemaUpgradeOpts+ <$> optional (argument str (metavar "PATH" <> help "Module directory (default: current directory)"))+ <*> switch (long "dry-run" <> help "Show what would change without modifying files")+ <*> switch (long "all" <> help "Upgrade all discovered modules")++schemaUpgradeFooter :: Doc+schemaUpgradeFooter =+ vsep+ [ pretty ("Detects missing or outdated fields in module.dhall files and" :: String),+ pretty ("rewrites them to match the current schema. Handles:" :: String),+ line,+ indent 2 $+ vsep+ [ pretty ("- Missing 'version' field" :: String),+ pretty ("- Missing 'patch' field on steps" :: String),+ pretty ("- Missing 'commands' field" :: String),+ pretty ("- Bare string dependencies (converts to record form)" :: String),+ pretty ("- 'List Text' dependency type annotation" :: String)+ ],+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou schema-upgrade # upgrade ./module.dhall" :: String),+ pretty ("seihou schema-upgrade ./my-module # upgrade specific module" :: String),+ pretty ("seihou schema-upgrade --dry-run # preview changes" :: String),+ pretty ("seihou schema-upgrade --all # upgrade all modules" :: String)+ ]+ ]++kitInfo :: ParserInfo Command+kitInfo =+ info+ (Kit <$> kitCommandParser <**> helper)+ ( fullDesc+ <> progDesc "Manage Claude Code and Codex skills and subagents"+ )++registryInfo :: ParserInfo Command+registryInfo =+ info+ (Registry <$> registryCommandParser <**> helper)+ ( fullDesc+ <> progDesc "Manage seihou-registry.dhall files"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Authoring-time operations on a multi-artifact repository's" :: String),+ pretty ("seihou-registry.dhall. Run against a writable checkout." :: String),+ line,+ pretty ("Current subcommands:" :: String),+ indent 2 $+ vsep+ [ pretty ("sync-versions Copy each entry's declared version into the registry" :: String),+ pretty ("validate Check that registry entries match their on-disk artifacts" :: String)+ ],+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou registry sync-versions" :: String),+ pretty ("seihou registry sync-versions --dry-run" :: String),+ pretty ("seihou registry sync-versions --check" :: String),+ pretty ("seihou registry validate" :: String)+ ]+ ]+ )+ )++registryCommandParser :: Parser RegistryCommand+registryCommandParser =+ hsubparser+ ( command "sync-versions" syncVersionsInfo+ <> command "validate" validateRegistryInfo+ )++syncVersionsInfo :: ParserInfo RegistryCommand+syncVersionsInfo =+ info+ (syncVersionsParser <**> helper)+ ( fullDesc+ <> progDesc "Populate registry entry versions from each module/recipe/blueprint/prompt"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Reads every entry's module.dhall, recipe.dhall, blueprint.dhall, or prompt.dhall," :: String),+ pretty ("copies the declared version into the registry, and rewrites" :: String),+ pretty ("seihou-registry.dhall. Hand-written comments and formatting are lost." :: String),+ line,+ pretty ("With --dry-run the diff is printed but the file is left untouched." :: String),+ pretty ("With --check the command exits 1 if any entry is out of sync — suitable" :: String),+ pretty ("for CI. --check takes precedence over --dry-run if both are given." :: String)+ ]+ )+ )++syncVersionsParser :: Parser RegistryCommand+syncVersionsParser =+ fmap RegistrySyncVersions $+ SyncVersionsOpts+ <$> optional+ ( option+ str+ ( long "dir"+ <> metavar "PATH"+ <> help "Registry repo root (default: current directory)"+ )+ )+ <*> switch (long "dry-run" <> help "Show diff without writing the registry file")+ <*> switch (long "check" <> help "Exit 1 if any entry is out of sync; do not write")++validateRegistryInfo :: ParserInfo RegistryCommand+validateRegistryInfo =+ info+ (validateRegistryParser <**> helper)+ ( fullDesc+ <> progDesc "Check that registry entries match their on-disk artifacts"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Validates a multi-artifact repository's seihou-registry.dhall:" :: String),+ indent 2 $+ vsep+ [ pretty ("- every entry path resolves to a module.dhall, recipe.dhall, blueprint.dhall, or prompt.dhall" :: String),+ pretty ("- entry names match [a-z][a-z0-9-]*" :: String),+ pretty ("- no name collisions between modules, recipes, blueprints, and prompts" :: String),+ pretty ("- entry paths are relative and contain no '..'" :: String),+ pretty ("- each entry's `version` matches the underlying module/recipe/blueprint/prompt" :: String)+ ],+ line,+ pretty ("Exits 1 on any failure. Run from a writable checkout of the registry repo." :: String)+ ]+ )+ )++validateRegistryParser :: Parser RegistryCommand+validateRegistryParser =+ fmap RegistryValidate $+ ValidateRegistryOpts+ <$> optional+ ( option+ str+ ( long "dir"+ <> metavar "PATH"+ <> help "Registry repo root (default: current directory)"+ )+ )++agentInfo :: ParserInfo Command+agentInfo =+ info+ (agentParser <**> helper)+ ( fullDesc+ <> progDesc "AI-powered agent commands"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Agent subcommands provide AI-assisted workflows powered by" :: String),+ pretty ("configurable CLI or API providers. Use --provider to select claude-cli, codex-cli," :: String),+ pretty ("anthropic, or openai, and --model for a provider-specific model." :: String),+ line,+ pretty ("Use --debug with any subcommand to print the resolved system" :: String),+ pretty ("prompt without contacting the configured provider." :: String),+ line,+ pretty ("Available subcommands:" :: String),+ indent 2 $+ vsep+ [ pretty ("assist AI-assisted template authoring prompt" :: String),+ pretty ("bootstrap Bootstrap a new module or multi-module repo" :: String),+ pretty ("setup Guided project setup: configure, run, and commit" :: String),+ pretty ("run Run an agent-driven blueprint" :: String)+ ]+ ]+ )+ )++agentParser :: Parser Command+agentParser =+ fmap Agent $+ AgentOpts+ <$> switch (long "debug" <> help "Print the resolved system prompt and exit")+ <*> optional+ ( option+ (T.pack <$> str)+ ( long "provider"+ <> metavar "PROVIDER"+ <> help "Agent provider: claude-cli, codex-cli, anthropic, or openai"+ )+ )+ <*> optional+ ( option+ (T.pack <$> str)+ ( long "model"+ <> metavar "MODEL"+ <> help "Agent model name or provider-specific model alias"+ )+ )+ <*> agentCommandParser++agentCommandParser :: Parser AgentCommand+agentCommandParser =+ subparser+ ( command "assist" agentAssistInfo+ <> command "bootstrap" agentBootstrapInfo+ <> command "setup" agentSetupInfo+ <> command "run" agentRunInfo+ )++agentAssistInfo :: ParserInfo AgentCommand+agentAssistInfo =+ info+ (agentAssistParser <**> helper)+ ( fullDesc+ <> progDesc "Launch AI-assisted template authoring session"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Renders a Seihou-aware prompt for creating and modifying" :: String),+ pretty ("modules, then starts the configured provider." :: String),+ pretty ("The prompt gathers context" :: String),+ pretty ("about your current directory (existing modules, manifest state," :: String),+ pretty ("available modules) and includes the Seihou" :: String),+ pretty ("module schema." :: String),+ line,+ pretty ("CLI providers open interactive Claude Code or Codex sessions;" :: String),+ pretty ("API providers run one-shot text completions." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou agent assist" :: String),+ pretty ("seihou agent assist \"create a rust project template\"" :: String),+ pretty ("seihou agent assist \"add a LICENSE step to my-module\"" :: String)+ ]+ ]+ )+ )++agentAssistParser :: Parser AgentCommand+agentAssistParser =+ fmap AgentAssist $+ AssistOpts+ <$> optional (argument (T.pack <$> str) (metavar "PROMPT" <> help "Initial prompt describing what you want to do"))+ <*> providerOption+ <*> modelOption++agentBootstrapInfo :: ParserInfo AgentCommand+agentBootstrapInfo =+ info+ (agentBootstrapParser <**> helper)+ ( fullDesc+ <> progDesc "Bootstrap a new module or multi-module repository"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Renders a Seihou-aware prompt for creating a complete module" :: String),+ pretty ("from scratch: defining variables," :: String),+ pretty ("writing templates, setting up prompts, and validating the result." :: String),+ line,+ pretty ("Use --repo to bootstrap a multi-module repository with a" :: String),+ pretty ("seihou-registry.dhall and multiple module directories." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou agent bootstrap" :: String),+ pretty ("seihou agent bootstrap \"a haskell project template\"" :: String),+ pretty ("seihou agent bootstrap --repo" :: String),+ pretty ("seihou agent bootstrap --repo \"team templates for rust projects\"" :: String)+ ]+ ]+ )+ )++agentBootstrapParser :: Parser AgentCommand+agentBootstrapParser =+ fmap AgentBootstrap $+ BootstrapOpts+ <$> optional (argument (T.pack <$> str) (metavar "PROMPT" <> help "Description of what to bootstrap"))+ <*> switch (long "repo" <> help "Bootstrap a multi-module repository with registry")+ <*> providerOption+ <*> modelOption++agentSetupInfo :: ParserInfo AgentCommand+agentSetupInfo =+ info+ (agentSetupParser <**> helper)+ ( fullDesc+ <> progDesc "Guided project setup: configure, run, and commit"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Renders a Seihou-aware prompt for using a module: selecting" :: String),+ pretty ("a module, configuring variables and" :: String),+ pretty ("context, running the module to generate files, verifying the output," :: String),+ pretty ("and committing the changes to git." :: String),+ line,+ pretty ("The rendered prompt is sent to the configured provider;" :: String),+ pretty ("--debug prints it without contacting that provider." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou agent setup" :: String),+ pretty ("seihou agent setup \"set up a haskell project with nix\"" :: String),+ pretty ("seihou agent setup \"add nix-flake module to this project\"" :: String)+ ]+ ]+ )+ )++agentSetupParser :: Parser AgentCommand+agentSetupParser =+ fmap AgentSetup $+ SetupOpts+ <$> optional (argument (T.pack <$> str) (metavar "PROMPT" <> help "Description of what you want to set up"))+ <*> providerOption+ <*> modelOption++agentRunInfo :: ParserInfo AgentCommand+agentRunInfo =+ info+ (agentRunParser <**> helper)+ ( fullDesc+ <> progDesc "Run an agent-driven blueprint"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Resolves the named blueprint, prompts for any required variables," :: String),+ pretty ("optionally applies the blueprint's baseModules as a starting scaffold," :: String),+ pretty ("renders the prompt template, and starts the configured" :: String),+ pretty ("provider." :: String),+ line,+ pretty ("Variable resolution follows the same precedence as 'seihou run':" :: String),+ pretty ("CLI overrides > env > local config > namespace > context > global > defaults" :: String),+ pretty ("> interactive prompts." :: String),+ line,+ pretty ("Pass --no-baseline to skip baseline application; --debug (on the parent" :: String),+ pretty ("'seihou agent --debug') prints the resolved system prompt without" :: String),+ pretty ("contacting the configured provider." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou agent run my-blueprint" :: String),+ pretty ("seihou agent run my-blueprint \"set this up for billing\"" :: String),+ pretty ("seihou agent run my-blueprint --var service.name=billing" :: String),+ pretty ("seihou agent run my-blueprint --no-baseline" :: String),+ pretty ("seihou agent --debug run my-blueprint" :: String)+ ]+ ]+ )+ )++agentRunParser :: Parser AgentCommand+agentRunParser =+ fmap AgentRun $+ BlueprintRunOpts+ <$> argument moduleNameReader (metavar "BLUEPRINT" <> help "Name of the blueprint to run")+ <*> optional (argument (T.pack <$> str) (metavar "PROMPT" <> help "Optional initial user prompt"))+ <*> many+ ( option+ varPair+ (long "var" <> metavar "KEY=VALUE" <> help "Variable override (repeatable)")+ )+ <*> switch (long "no-baseline" <> help "Skip applying the blueprint's baseModules before rendering the prompt")+ <*> optional (option (T.pack <$> str) (long "namespace" <> metavar "NS" <> help "Override namespace for config lookup"))+ <*> optional (option (T.pack <$> str) (long "context" <> short 'c' <> metavar "CTX" <> help "Override context for config lookup"))+ <*> switch (long "verbose" <> short 'v' <> help "Show detailed progress messages")+ <*> switch (long "force" <> help "Auto-resolve baseline conflicts (accept new files)")+ <*> providerOption+ <*> modelOption++promptInfo :: ParserInfo Command+promptInfo =+ info+ (promptParser <**> helper)+ ( fullDesc+ <> progDesc "Run first-class agent-session prompts"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Prompt subcommands render reusable prompt.dhall artifacts and" :: String),+ pretty ("start the configured provider. Use 'prompt run --debug' to print" :: String),+ pretty ("the fully rendered prompt without contacting a provider." :: String),+ line,+ pretty ("Available subcommands:" :: String),+ indent 2 $+ vsep+ [ pretty ("run Resolve, render, and launch a prompt" :: String)+ ]+ ]+ )+ )++promptParser :: Parser Command+promptParser =+ fmap Prompt $+ subparser+ (command "run" promptRunInfo)++promptRunInfo :: ParserInfo PromptCommand+promptRunInfo =+ info+ (promptRunParser <**> helper)+ ( fullDesc+ <> progDesc "Run an agent-session prompt"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Resolves the named prompt, prompts for any required variables," :: String),+ pretty ("runs command-derived variables, renders the prompt body, and" :: String),+ pretty ("starts the configured provider." :: String),+ line,+ pretty ("Variable resolution follows the same precedence as 'seihou run':" :: String),+ pretty ("CLI overrides > env > local config > namespace > context > global > defaults" :: String),+ pretty ("> interactive prompts. Command-derived variables fill any remaining" :: String),+ pretty ("prompt variables after that chain resolves." :: String),+ line,+ pretty ("CLI providers open interactive Claude Code or Codex sessions;" :: String),+ pretty ("API providers run one-shot text completions. Use --debug to print" :: String),+ pretty ("the rendered prompt and skip provider launch." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou prompt run review-changes" :: String),+ pretty ("seihou prompt run review-changes \"focus on API changes\"" :: String),+ pretty ("seihou prompt run review-changes --var project.name=demo" :: String),+ pretty ("seihou prompt run review-changes --debug" :: String)+ ]+ ]+ )+ )++promptRunParser :: Parser PromptCommand+promptRunParser =+ fmap PromptRun $+ PromptRunOpts+ <$> argument moduleNameReader (metavar "PROMPT" <> help "Name of the prompt to run")+ <*> optional (argument (T.pack <$> str) (metavar "USER-PROMPT" <> help "Optional initial user prompt"))+ <*> many+ ( option+ varPair+ (long "var" <> metavar "KEY=VALUE" <> help "Variable override (repeatable)")+ )+ <*> optional (option (T.pack <$> str) (long "namespace" <> metavar "NS" <> help "Override namespace for config lookup"))+ <*> optional (option (T.pack <$> str) (long "context" <> short 'c' <> metavar "CTX" <> help "Override context for config lookup"))+ <*> switch (long "verbose" <> short 'v' <> help "Show detailed progress messages")+ <*> switch (long "debug" <> help "Print the rendered prompt and exit")+ <*> providerOption+ <*> modelOption++helpCmdInfo :: ParserInfo Command+helpCmdInfo =+ info+ (HelpCmd <$> helpCommandParser <**> helper)+ ( fullDesc+ <> progDesc "Show help for commands and topics"+ )++extensionInfo :: ParserInfo Command+extensionInfo =+ info+ (Extension <$> extensionParser <**> helper)+ ( fullDesc+ <> progDesc "Run external seihou extensions"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Extensions are external executables named seihou-<name>-extension." :: String),+ pretty ("Everything after '--' is forwarded unchanged to the extension process." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou extension run okf -- --help" :: String),+ pretty ("seihou extension run okf -- docs --dir . --out okf-docs" :: String)+ ]+ ]+ )+ )++extensionParser :: Parser ExtensionCommand+extensionParser =+ hsubparser+ (command "run" extensionRunInfo)++extensionRunInfo :: ParserInfo ExtensionCommand+extensionRunInfo =+ info+ (extensionRunParser <**> helper)+ ( fullDesc+ <> progDesc "Run an extension executable from PATH"+ )++extensionRunParser :: Parser ExtensionCommand+extensionRunParser =+ fmap ExtensionRun $+ ExtensionRunOpts+ <$> argument (T.pack <$> str) (metavar "NAME" <> help "Extension name")+ <*> many (strArgument (metavar "ARGS..."))++completionsInfo :: ParserInfo Command+completionsInfo =+ info+ (completionsParser <**> helper)+ ( fullDesc+ <> progDesc "Generate shell completion scripts"+ <> footerDoc+ ( Just $+ vsep+ [ pretty ("Outputs a completion script for the specified shell. Source the" :: String),+ pretty ("script in your shell profile to enable Tab completion for all" :: String),+ pretty ("seihou commands, subcommands, and flags." :: String),+ line,+ pretty ("Examples:" :: String),+ indent 2 $+ vsep+ [ pretty ("seihou completions bash > ~/.local/share/bash-completion/completions/seihou" :: String),+ pretty ("seihou completions zsh > ~/.zfunc/_seihou" :: String),+ pretty ("seihou completions fish > ~/.config/fish/completions/seihou.fish" :: String)+ ]+ ]+ )+ )++completionsParser :: Parser Command+completionsParser =+ fmap Completions $+ subparser+ ( command "bash" (info (pure CompletionsBash) (progDesc "Generate Bash completion script"))+ <> command "zsh" (info (pure CompletionsZsh) (progDesc "Generate Zsh completion script"))+ <> command "fish" (info (pure CompletionsFish) (progDesc "Generate Fish completion script"))+ )++-- Helpers++moduleNameReader :: ReadM ModuleName+moduleNameReader = ModuleName . T.pack <$> str++varPair :: ReadM (Text, Text)+varPair = eitherReader $ \s ->+ case T.breakOn "=" (T.pack s) of+ (k, v)+ | T.null k -> Left "variable name cannot be empty"+ | T.null v -> Left "expected KEY=VALUE format"+ | otherwise -> Right (k, T.drop 1 v)++providerOption :: Parser (Maybe Text)+providerOption =+ optional $+ option+ (T.pack <$> str)+ ( long "provider"+ <> metavar "PROVIDER"+ <> help "Agent provider: claude-cli, codex-cli, anthropic, or openai"+ )++modelOption :: Parser (Maybe Text)+modelOption =+ optional $+ option+ (T.pack <$> str)+ ( long "model"+ <> metavar "MODEL"+ <> help "Agent model name or provider-specific model alias"+ )
+ src-exe/Seihou/CLI/Completions.hs view
@@ -0,0 +1,16 @@+module Seihou.CLI.Completions+ ( handleCompletionsCommand,+ )+where++import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (CompletionsCommand (..))+import Seihou.CLI.Completions.Bash (generateBashCompletion)+import Seihou.CLI.Completions.Fish (generateFishCompletion)+import Seihou.CLI.Completions.Zsh (generateZshCompletion)++handleCompletionsCommand :: CompletionsCommand -> IO ()+handleCompletionsCommand = \case+ CompletionsBash -> TIO.putStrLn generateBashCompletion+ CompletionsZsh -> TIO.putStrLn generateZshCompletion+ CompletionsFish -> TIO.putStrLn generateFishCompletion
+ src-exe/Seihou/CLI/Config.hs view
@@ -0,0 +1,157 @@+module Seihou.CLI.Config+ ( handleConfig,+ )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (ConfigAction (..), ConfigOpts (..))+import Seihou.CLI.Shared (formatConfigError, logIO)+import Seihou.Core.Types (ConfigError, ConfigScope (..), LogLevel (..))+import Seihou.Effect.ConfigReader (readContextConfig, readGlobalConfig, readLocalConfig, readNamespaceConfig)+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Effect.ConfigWriter (deleteConfigValue, listConfigValues, writeConfigValue)+import Seihou.Effect.ConfigWriterInterp (runConfigWriter)+import Seihou.Effect.Logger (logError)+import Seihou.Prelude+import System.Exit (exitFailure)++handleConfig :: ConfigOpts -> IO ()+handleConfig ConfigOpts {configAction, configGlobal, configNamespace, configContext, configEffective} = do+ let scope = resolveScope configGlobal configNamespace configContext+ case configAction of+ ConfigSet key value -> handleSet scope key value+ ConfigGet key -> handleGet scope key+ ConfigUnset key -> handleUnset scope key+ ConfigList+ | configEffective -> handleListEffective configNamespace configContext+ | otherwise -> handleList configGlobal configNamespace configContext++resolveScope :: Bool -> Maybe Text -> Maybe Text -> ConfigScope+resolveScope True _ _ = ScopeGlobal+resolveScope _ (Just ns) _ = ScopeNamespace ns+resolveScope _ _ (Just ctx) = ScopeContext ctx+resolveScope _ _ _ = ScopeLocal++scopeLabel :: ConfigScope -> Text+scopeLabel ScopeLocal = "local"+scopeLabel (ScopeNamespace ns) = "namespace " <> ns+scopeLabel (ScopeContext ctx) = "context " <> ctx+scopeLabel ScopeGlobal = "global"++handleSet :: ConfigScope -> Text -> Text -> IO ()+handleSet scope key value = do+ runEff $ runConfigWriter $ writeConfigValue scope key value+ TIO.putStrLn $ "Set " <> key <> " = " <> value <> " in " <> scopeLabel scope <> " config"++handleGet :: ConfigScope -> Text -> IO ()+handleGet scope key = do+ result <- runEff $ runConfigWriter $ listConfigValues scope+ case result of+ Left err -> configError err+ Right m -> case Map.lookup key m of+ Just val -> TIO.putStrLn val+ Nothing -> TIO.putStrLn $ key <> " is not set in " <> scopeLabel scope <> " config"++handleUnset :: ConfigScope -> Text -> IO ()+handleUnset scope key = do+ result <- runEff $ runConfigWriter $ listConfigValues scope+ case result of+ Left err -> configError err+ Right m ->+ if Map.member key m+ then do+ runEff $ runConfigWriter $ deleteConfigValue scope key+ TIO.putStrLn $ "Removed " <> key <> " from " <> scopeLabel scope <> " config"+ else TIO.putStrLn $ key <> " is not set in " <> scopeLabel scope <> " config"++handleList :: Bool -> Maybe Text -> Maybe Text -> IO ()+handleList isGlobal mNamespace mContext+ | isGlobal = listScope ScopeGlobal+ | Just ns <- mNamespace = listScope (ScopeNamespace ns)+ | Just ctx <- mContext = listScope (ScopeContext ctx)+ | otherwise = listAllScopes++-- | Show the merged effective config across all scopes.+-- Precedence: local > namespace > global (matching variable resolution order).+handleListEffective :: Maybe Text -> Maybe Text -> IO ()+handleListEffective mNamespace mContext = do+ results <- runEff $ runConfigReader $ do+ l <- readLocalConfig+ n <- case mNamespace of+ Just ns -> readNamespaceConfig ns+ Nothing -> pure (Right Map.empty)+ c <- case mContext of+ Just ctx -> readContextConfig ctx+ Nothing -> pure (Right Map.empty)+ g <- readGlobalConfig+ pure (l, n, c, g)+ let (localResult, nsResult, ctxResult, globalResult) = results+ case (globalResult, ctxResult, nsResult, localResult) of+ (Left err, _, _, _) -> configError err+ (_, Left err, _, _) -> configError err+ (_, _, Left err, _) -> configError err+ (_, _, _, Left err) -> configError err+ (Right globalMap, Right ctxMap, Right nsMap, Right localMap) -> do+ -- Build merged map with source tracking: local > namespace > context > global+ let taggedGlobal = Map.map (\v -> (v, "global" :: Text)) globalMap+ taggedCtx = Map.map (\v -> (v, maybe "context" (\ctx -> "context: " <> ctx) mContext)) ctxMap+ taggedNs = Map.map (\v -> (v, maybe "namespace" (\ns -> "namespace: " <> ns) mNamespace)) nsMap+ taggedLocal = Map.map (\v -> (v, "local")) localMap+ merged = taggedLocal `Map.union` taggedNs `Map.union` taggedCtx `Map.union` taggedGlobal+ if Map.null merged+ then TIO.putStrLn "No config values set in any scope."+ else do+ TIO.putStrLn "Effective config:"+ let entries = Map.toAscList merged+ maxKeyLen = maximum (0 : map (T.length . fst) entries)+ maxValLen = maximum (0 : map (T.length . fst . snd) entries)+ mapM_ (printEffectiveEntry maxKeyLen maxValLen) entries++printEffectiveEntry :: Int -> Int -> (Text, (Text, Text)) -> IO ()+printEffectiveEntry maxKeyLen maxValLen (key, (value, source)) = do+ let keyPad = T.replicate (maxKeyLen - T.length key) " "+ valPad = T.replicate (maxValLen - T.length value) " "+ TIO.putStrLn $ " " <> key <> keyPad <> " = " <> value <> valPad <> " [" <> source <> "]"++listScope :: ConfigScope -> IO ()+listScope scope = do+ result <- runEff $ runConfigWriter $ listConfigValues scope+ case result of+ Left err -> configError err+ Right m+ | Map.null m -> TIO.putStrLn $ "No config values in " <> scopeLabel scope <> " scope"+ | otherwise -> do+ TIO.putStrLn $ scopeLabel scope <> " config:"+ mapM_ printEntry (Map.toAscList m)++listAllScopes :: IO ()+listAllScopes = do+ results <- runEff $ runConfigReader $ do+ l <- readLocalConfig+ g <- readGlobalConfig+ pure (l, g)+ let (localResult, globalResult) = results+ printScopeIfNonEmpty "local" localResult+ printScopeIfNonEmpty "global" globalResult++printScopeIfNonEmpty :: Text -> Either ConfigError (Map.Map Text Text) -> IO ()+printScopeIfNonEmpty label result =+ case result of+ Left err -> do+ TIO.putStrLn $ label <> " config: " <> formatConfigError err+ Right m+ | Map.null m -> pure ()+ | otherwise -> do+ TIO.putStrLn $ label <> " config:"+ mapM_ printEntry (Map.toAscList m)+ TIO.putStrLn ""++printEntry :: (Text, Text) -> IO ()+printEntry (key, value) = TIO.putStrLn $ " " <> key <> " = " <> value++configError :: ConfigError -> IO ()+configError err = do+ logIO LogNormal (logError $ "Config error: " <> formatConfigError err)+ exitFailure
+ src-exe/Seihou/CLI/Context.hs view
@@ -0,0 +1,150 @@+module Seihou.CLI.Context+ ( handleContext,+ )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (ContextAction (..))+import Seihou.Core.Context (resolveContext, validateContextName)+import Seihou.Effect.Fzf (selectOne)+import Seihou.Effect.FzfInterp (runFzfIO)+import Seihou.Fzf (Candidate (..), FzfResult (..), detectFzfConfig, isFzfUsable, withAnsi, withHeight, withNoSort, withPrompt)+import Seihou.Fzf qualified+import Seihou.Prelude+import System.Directory+ ( XdgDirectory (..),+ createDirectoryIfMissing,+ doesDirectoryExist,+ doesFileExist,+ getCurrentDirectory,+ getXdgDirectory,+ listDirectory,+ removeFile,+ )+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..), exitFailure, exitWith)++handleContext :: ContextAction -> IO ()+handleContext ContextShow = showContext+handleContext (ContextSet mName) = do+ name <- case mName of+ Just n -> pure n+ Nothing -> do+ fzfCfg <- detectFzfConfig+ if isFzfUsable fzfCfg+ then do+ result <- selectContextFzf fzfCfg+ case result of+ FzfSelected n -> pure n+ FzfCancelled -> exitWith ExitSuccess+ FzfNoMatch -> do+ TIO.putStrLn "No contexts found."+ exitFailure+ FzfError err -> do+ TIO.putStrLn $ "fzf error: " <> err+ exitFailure+ else do+ TIO.putStrLn "NAME argument is required when fzf is not available."+ exitFailure+ setProjectContext name+handleContext (ContextDefault name) = setGlobalDefault name+handleContext ContextClear = clearProjectContext+handleContext ContextClearDefault = clearGlobalDefault++-- | Select a context via fzf from available context directories.+selectContextFzf :: Seihou.Fzf.FzfConfig -> IO (FzfResult Text)+selectContextFzf fzfCfg = do+ base <- getXdgDirectory XdgConfig "seihou"+ let contextsDir = base </> "contexts"+ exists <- doesDirectoryExist contextsDir+ if not exists+ then pure FzfNoMatch+ else do+ entries <- listDirectory contextsDir+ dirs <- filterM (doesDirectoryExist . (contextsDir </>)) entries+ let candidates = [Candidate {candidateDisplay = T.pack d, candidateValue = T.pack d} | d <- dirs]+ opts = withPrompt "context> " <> withHeight "40%" <> withAnsi <> withNoSort+ runEff $ runFzfIO fzfCfg $ selectOne opts candidates+ where+ filterM _ [] = pure []+ filterM p (x : xs) = do+ b <- p x+ rest <- filterM p xs+ if b then pure (x : rest) else pure rest++showContext :: IO ()+showContext = do+ envPairs <- getEnvironment+ let envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]+ result <- resolveContext Nothing envVars+ case result of+ Nothing -> TIO.putStrLn "No active context."+ Just ctx -> do+ TIO.putStrLn $ "Active context: " <> ctx+ -- Show where it came from+ case Map.lookup "SEIHOU_CONTEXT" envVars of+ Just _ -> TIO.putStrLn " Source: SEIHOU_CONTEXT environment variable"+ Nothing -> do+ cwd <- getCurrentDirectory+ let projectFile = cwd </> ".seihou" </> "context"+ projectExists <- doesFileExist projectFile+ if projectExists+ then TIO.putStrLn " Source: .seihou/context (project)"+ else do+ base <- getXdgDirectory XdgConfig "seihou"+ let defaultFile = base </> "default-context"+ defaultExists <- doesFileExist defaultFile+ if defaultExists+ then TIO.putStrLn $ " Source: " <> T.pack defaultFile <> " (global default)"+ else TIO.putStrLn " Source: unknown"++setProjectContext :: Text -> IO ()+setProjectContext name = do+ case validateContextName name of+ Just err -> do+ TIO.putStrLn $ "Invalid context name: " <> err+ exitFailure+ Nothing -> do+ cwd <- getCurrentDirectory+ let dir = cwd </> ".seihou"+ path = dir </> "context"+ createDirectoryIfMissing True dir+ TIO.writeFile path (name <> "\n")+ TIO.putStrLn $ "Set project context to: " <> name++setGlobalDefault :: Text -> IO ()+setGlobalDefault name = do+ case validateContextName name of+ Just err -> do+ TIO.putStrLn $ "Invalid context name: " <> err+ exitFailure+ Nothing -> do+ base <- getXdgDirectory XdgConfig "seihou"+ createDirectoryIfMissing True base+ let path = base </> "default-context"+ TIO.writeFile path (name <> "\n")+ TIO.putStrLn $ "Set global default context to: " <> name++clearProjectContext :: IO ()+clearProjectContext = do+ cwd <- getCurrentDirectory+ let path = cwd </> ".seihou" </> "context"+ exists <- doesFileExist path+ if exists+ then do+ removeFile path+ TIO.putStrLn "Removed project context."+ else TIO.putStrLn "No project context set."++clearGlobalDefault :: IO ()+clearGlobalDefault = do+ base <- getXdgDirectory XdgConfig "seihou"+ let path = base </> "default-context"+ exists <- doesFileExist path+ if exists+ then do+ removeFile path+ TIO.putStrLn "Removed global default context."+ else TIO.putStrLn "No global default context set."
+ src-exe/Seihou/CLI/Help.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE TemplateHaskell #-}++module Seihou.CLI.Help+ ( HelpCommand (..),+ helpCommandParser,+ handleHelpCommand,+ )+where++import Data.FileEmbed (embedStringFile)+import Data.Foldable (forM_)+import Data.List (find)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Options.Applicative+import Seihou.Prelude++data HelpTopic = HelpTopic+ { topicName :: !Text,+ topicDescription :: !Text,+ topicContent :: !Text+ }++data HelpCommand+ = ListTopics+ | ShowTopic !Text+ deriving stock (Eq, Show)++helpTopics :: [HelpTopic]+helpTopics =+ [ HelpTopic "agent" "Configurable AI assistance commands" agentContent,+ HelpTopic "blueprints" "Agent-driven project blueprints" blueprintsContent,+ HelpTopic "modules" "How Seihou modules work" modulesContent,+ HelpTopic "variables" "Variable declaration, resolution, and overrides" variablesContent,+ HelpTopic "contexts" "Using contexts for environment-specific config" contextsContent,+ HelpTopic "config" "Config scopes, reading, and writing values" configContent,+ HelpTopic "git-repository" "Sharing and installing items from git" gitRepositoryContent,+ HelpTopic "kit" "Manage Claude Code and Codex skills and subagents" kitContent,+ HelpTopic "migrations" "Migrating a project between module versions" migrationsContent,+ HelpTopic "prompts" "Reusable agent-session prompt artifacts" promptsContent,+ HelpTopic "templating" "Placeholder substitution, {{#if}} blocks, and patterns" templatingContent+ ]++agentContent :: Text+agentContent = $(embedStringFile "help/agent.md")++blueprintsContent :: Text+blueprintsContent = $(embedStringFile "help/blueprints.md")++modulesContent :: Text+modulesContent = $(embedStringFile "help/modules.md")++variablesContent :: Text+variablesContent = $(embedStringFile "help/variables.md")++contextsContent :: Text+contextsContent = $(embedStringFile "help/contexts.md")++configContent :: Text+configContent = $(embedStringFile "help/config.md")++gitRepositoryContent :: Text+gitRepositoryContent = $(embedStringFile "help/git-repository.md")++kitContent :: Text+kitContent = $(embedStringFile "help/kit.md")++migrationsContent :: Text+migrationsContent = $(embedStringFile "help/migrations.md")++promptsContent :: Text+promptsContent = $(embedStringFile "help/prompts.md")++templatingContent :: Text+templatingContent = $(embedStringFile "help/templating.md")++helpCommandParser :: Parser HelpCommand+helpCommandParser =+ showTopicParser <|> pure ListTopics++showTopicParser :: Parser HelpCommand+showTopicParser =+ ShowTopic+ <$> strArgument+ ( metavar "TOPIC"+ <> help ("Help topic: " <> T.unpack topicList)+ )+ where+ topicList = T.intercalate ", " (map (.topicName) helpTopics)++handleHelpCommand :: HelpCommand -> IO ()+handleHelpCommand = \case+ ListTopics -> listTopics+ ShowTopic name -> showTopic name++listTopics :: IO ()+listTopics = do+ TIO.putStrLn "HELP TOPICS\n"+ forM_ helpTopics $ \t ->+ TIO.putStrLn $ " " <> padRight 17 t.topicName <> t.topicDescription+ TIO.putStrLn "\nUse 'seihou help <topic>' for details."++padRight :: Int -> Text -> Text+padRight n t = t <> T.replicate (max 0 (n - T.length t)) " "++showTopic :: Text -> IO ()+showTopic name =+ case find (\t -> t.topicName == T.toLower name) helpTopics of+ Just t -> TIO.putStrLn t.topicContent+ Nothing -> do+ TIO.putStrLn $ "Unknown topic: " <> name+ TIO.putStrLn $ "Available: " <> T.intercalate ", " (map (.topicName) helpTopics)
+ src-exe/Seihou/CLI/Install.hs view
@@ -0,0 +1,500 @@+module Seihou.CLI.Install+ ( handleInstall,+ installModuleDir,+ cloneRepo,+ copyDirectoryRecursive,+ )+where++import Control.Applicative ((<|>))+import Control.Monad (when)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.BrowseFormat (kindLabel)+import Seihou.CLI.Commands (InstallOpts (..))+import Seihou.CLI.InstallHistory (HistoryEntry (..), InstallHistory (..), readHistory, recordUrl)+import Seihou.CLI.InstallShared (cloneRepo, copyDirectoryRecursive, installModuleDir)+import Seihou.CLI.Registry.Sync (checkRegistryVersionDrift)+import Seihou.CLI.Shared (logIO)+import Seihou.Core.AgentPrompt (validateAgentPrompt)+import Seihou.Core.Blueprint (validateBlueprint)+import Seihou.Core.Install (parseModuleName)+import Seihou.Core.Module (validateModule)+import Seihou.Core.Registry (EntryKind (..), Registry (..), RegistryEntry (..), RepoContents (..), discoverRepoContents, validateRegistry)+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalAgentPromptFromFile, evalBlueprintFromFile, evalModuleFromFile, evalRegistryFromFile)+import Seihou.Effect.Fzf (selectOne)+import Seihou.Effect.FzfInterp (runFzfIO)+import Seihou.Effect.Logger (logError, logWarn)+import Seihou.Fzf (Candidate (..), FzfConfig, FzfResult (..), detectFzfConfig, isFzfUsable, withAnsi, withHeader, withHeight, withNoSort, withPrompt)+import Seihou.Fzf qualified+import Seihou.Prelude+import System.Directory (doesFileExist)+import System.Exit (exitFailure)+import System.IO (hFlush, stdout)+import System.IO.Temp (withSystemTempDirectory)++handleInstall :: InstallOpts -> IO ()+handleInstall iopts = do+ source <- resolveSource iopts.installSource++ TIO.putStrLn $ "Installing from " <> source <> "..."++ -- Clone into a temporary directory+ withSystemTempDirectory "seihou-install" $ \tmpDir -> do+ let repoName = parseModuleName source+ cloneDir = tmpDir </> repoName+ cloneRes <- cloneRepo source cloneDir+ case cloneRes of+ Left err -> do+ logIO LogNormal $ do+ logError err+ exitFailure+ Right () -> TIO.putStrLn " Cloned repository"++ -- Determine what the repo contains+ contents <- discoverRepoContents evalRegistryFromFile cloneDir+ case contents of+ EmptyRepo -> do+ logIO LogNormal (logError "repository contains neither seihou-registry.dhall nor a supported runnable Dhall file.")+ exitFailure+ SingleModule rootDir -> do+ when (not (null iopts.installModules) || iopts.installAll) $+ logIO LogNormal (logWarn "--module and --all flags are ignored for single-module repositories.")+ installSingleModule iopts rootDir source Nothing+ SingleRecipe rootDir -> do+ when (not (null iopts.installModules) || iopts.installAll) $+ logIO LogNormal (logWarn "--module and --all flags are ignored for single-recipe repositories.")+ installSingleRecipe iopts rootDir source+ SingleBlueprint rootDir -> do+ when (not (null iopts.installModules) || iopts.installAll) $+ logIO LogNormal (logWarn "--module and --all flags are ignored for single-blueprint repositories.")+ installSingleBlueprint iopts rootDir source+ SinglePrompt rootDir -> do+ when (not (null iopts.installModules) || iopts.installAll) $+ logIO LogNormal (logWarn "--module and --all flags are ignored for single-prompt repositories.")+ installSinglePrompt iopts rootDir source+ MultiModule registry -> do+ regErrors <- validateRegistry cloneDir registry+ if not (null regErrors)+ then do+ logIO LogNormal $ do+ logError "registry has validation errors:"+ mapM_ (\e -> logError $ " - " <> e) regErrors+ exitFailure+ else do+ driftWarnings <- checkRegistryVersionDrift cloneDir registry+ logIO LogNormal (mapM_ logWarn driftWarnings)+ installFromRegistry iopts cloneDir registry source++ -- Record URL in history for future recall (only reached on success)+ recordUrl source++-- | Resolve the install source: use the explicit URL if given, otherwise pick from history.+resolveSource :: Maybe Text -> IO Text+resolveSource (Just url) = pure url+resolveSource Nothing = do+ history <- readHistory+ case history.entries of+ [] -> do+ TIO.putStrLn "No URL specified and no install history found."+ TIO.putStrLn "Usage: seihou install <git-url>"+ exitFailure+ entries -> do+ fzfCfg <- detectFzfConfig+ if isFzfUsable fzfCfg+ then fzfUrlSelection fzfCfg entries+ else promptUrlSelection entries++-- | FZF selection of a URL from history.+fzfUrlSelection :: FzfConfig -> [HistoryEntry] -> IO Text+fzfUrlSelection fzfCfg entries = do+ let candidates =+ [ Candidate+ { candidateDisplay = entry.url,+ candidateValue = entry.url+ }+ | entry <- entries+ ]+ opts = withPrompt "install> " <> withHeader "Select a previously used source:" <> withHeight "40%" <> withAnsi <> withNoSort+ result <- runEff $ runFzfIO fzfCfg $ selectOne opts candidates+ case result of+ FzfSelected url -> pure url+ FzfCancelled -> do+ TIO.putStrLn "Cancelled."+ exitFailure+ FzfNoMatch -> do+ TIO.putStrLn "No match."+ exitFailure+ FzfError err -> do+ TIO.putStrLn $ "fzf error: " <> err <> ", falling back to prompt"+ promptUrlSelection entries++-- | Numbered prompt fallback for URL selection.+promptUrlSelection :: [HistoryEntry] -> IO Text+promptUrlSelection entries = do+ TIO.putStrLn ""+ TIO.putStrLn "Previously used sources:"+ let numbered = zip [1 :: Int ..] entries+ mapM_+ (\(i, entry) -> TIO.putStrLn $ " " <> T.pack (show i) <> ") " <> entry.url)+ numbered+ TIO.putStrLn ""+ TIO.putStr "Select a source (number): "+ hFlush stdout+ input <- TIO.getLine+ case readMaybe (T.unpack (T.strip input)) of+ Just n+ | n >= 1 && n <= length entries ->+ pure (entries !! (n - 1)).url+ _ -> do+ TIO.putStrLn "Invalid selection."+ exitFailure++-- | Install a single-module repo (legacy behavior).+installSingleModule :: InstallOpts -> FilePath -> Text -> Maybe Text -> IO ()+installSingleModule iopts rootDir source registryName = do+ let name = case iopts.installName of+ Just n -> T.unpack n+ Nothing -> parseModuleName source++ let dhallFile = rootDir </> "module.dhall"+ decoded <- evalModuleFromFile dhallFile+ modul <- case decoded of+ Left err -> do+ logIO LogNormal $ do+ logError "repository is not a valid seihou module."+ logError $ " " <> T.pack (show err)+ exitFailure+ Right m -> pure m++ result <- validateModule rootDir modul+ case result of+ Left (ValidationError _ errors) -> do+ logIO LogNormal $ do+ logError "module has validation errors:"+ mapM_ (\e -> logError $ " - " <> e) errors+ exitFailure+ Left err -> do+ logIO LogNormal (logError $ T.pack (show err))+ exitFailure+ Right _ -> pure ()+ TIO.putStrLn " Validated module definition"++ installModuleDir rootDir name source registryName modul.version []+ TIO.putStrLn ""+ TIO.putStrLn $ "Module available as: " <> T.pack name++-- | Install a single-recipe repo.+installSingleRecipe :: InstallOpts -> FilePath -> Text -> IO ()+installSingleRecipe iopts rootDir source = do+ let name = case iopts.installName of+ Just n -> T.unpack n+ Nothing -> parseModuleName source++ -- Validate recipe.dhall exists (discoverRepoContents already confirmed it)+ TIO.putStrLn " Validated recipe definition"++ installModuleDir rootDir name source Nothing Nothing []+ TIO.putStrLn ""+ TIO.putStrLn $ "Recipe available as: " <> T.pack name++-- | Install a single-blueprint repo.+installSingleBlueprint :: InstallOpts -> FilePath -> Text -> IO ()+installSingleBlueprint iopts rootDir source = do+ let name = case iopts.installName of+ Just n -> T.unpack n+ Nothing -> parseModuleName source++ let dhallFile = rootDir </> "blueprint.dhall"+ decoded <- evalBlueprintFromFile dhallFile+ bp <- case decoded of+ Left err -> do+ logIO LogNormal $ do+ logError "repository is not a valid seihou blueprint."+ logError $ " " <> T.pack (show err)+ exitFailure+ Right b -> pure b++ result <- validateBlueprint rootDir bp+ case result of+ Left (ValidationError _ errors) -> do+ logIO LogNormal $ do+ logError "blueprint has validation errors:"+ mapM_ (\e -> logError $ " - " <> e) errors+ exitFailure+ Left err -> do+ logIO LogNormal (logError $ T.pack (show err))+ exitFailure+ Right _ -> pure ()+ TIO.putStrLn " Validated blueprint definition"++ let bpVersion = case bp of Blueprint _ v _ _ _ _ _ _ _ _ -> v+ installModuleDir rootDir name source Nothing bpVersion []+ TIO.putStrLn ""+ TIO.putStrLn $ "Blueprint available as: " <> T.pack name++-- | Install a single-prompt repo.+installSinglePrompt :: InstallOpts -> FilePath -> Text -> IO ()+installSinglePrompt iopts rootDir source = do+ let name = case iopts.installName of+ Just n -> T.unpack n+ Nothing -> parseModuleName source++ let dhallFile = rootDir </> "prompt.dhall"+ decoded <- evalAgentPromptFromFile dhallFile+ prompt <- case decoded of+ Left err -> do+ logIO LogNormal $ do+ logError "repository is not a valid seihou prompt."+ logError $ " " <> T.pack (show err)+ exitFailure+ Right p -> pure p++ result <- validateAgentPrompt rootDir prompt+ case result of+ Left (ValidationError _ errors) -> do+ logIO LogNormal $ do+ logError "prompt has validation errors:"+ mapM_ (\e -> logError $ " - " <> e) errors+ exitFailure+ Left err -> do+ logIO LogNormal (logError $ T.pack (show err))+ exitFailure+ Right _ -> pure ()+ TIO.putStrLn " Validated prompt definition"++ installModuleDir rootDir name source Nothing prompt.version []+ TIO.putStrLn ""+ TIO.putStrLn $ "Prompt available as: " <> T.pack name++-- | Install from a multi-module registry.+installFromRegistry :: InstallOpts -> FilePath -> Registry -> Text -> IO ()+installFromRegistry iopts cloneDir registry source = do+ selected <- selectModules iopts registry+ if null selected+ then TIO.putStrLn "No entries selected."+ else do+ results <- mapM (installRegistryEntry cloneDir source registry.repoName) selected+ let succeeded = length (filter id results)+ failed = length results - succeeded+ TIO.putStrLn ""+ TIO.putStrLn $+ T.pack (show succeeded)+ <> " "+ <> (if succeeded == 1 then "entry" else "entries")+ <> " installed"+ <> (if failed > 0 then ", " <> T.pack (show failed) <> " failed" else "")+ <> "."++-- | All registry entries (modules, recipes, blueprints, prompts) in display order.+-- Used wherever installation must treat all four kinds uniformly.+allEntries :: Registry -> [RegistryEntry]+allEntries registry = registry.modules ++ registry.recipes ++ registry.blueprints ++ registry.prompts++-- | Pair each registry entry with its 'EntryKind' tag, preserving the+-- module → recipe → blueprint → prompt display order. Used by the install picker+-- to render per-kind labels and by callers that need to discriminate+-- after selection.+labelledEntries :: Registry -> [(EntryKind, RegistryEntry)]+labelledEntries registry =+ map ((,) ModuleEntry) registry.modules+ ++ map ((,) RecipeEntry) registry.recipes+ ++ map ((,) BlueprintEntry) registry.blueprints+ ++ map ((,) PromptEntry) registry.prompts++-- | Select which modules to install from a registry.+selectModules :: InstallOpts -> Registry -> IO [RegistryEntry]+selectModules iopts registry+ | iopts.installAll = pure (allEntries registry)+ | not (null iopts.installModules) = do+ let entries = allEntries registry+ findEntry name = filter (\e -> e.name.unModuleName == name) entries+ (found, missing) =+ foldr+ ( \name (f, m) -> case findEntry name of+ (e : _) -> (e : f, m)+ [] -> (f, name : m)+ )+ ([], [])+ iopts.installModules+ if not (null missing)+ then do+ logIO LogNormal $ do+ logError "the following entries were not found in the registry:"+ mapM_ (\n -> logError $ " - " <> n) missing+ exitFailure+ else pure found+ | otherwise = do+ fzfCfg <- detectFzfConfig+ if isFzfUsable fzfCfg+ then fzfModuleSelection fzfCfg registry+ else promptModuleSelection registry++-- | Interactive module selection via fzf.+fzfModuleSelection :: Seihou.Fzf.FzfConfig -> Registry -> IO [RegistryEntry]+fzfModuleSelection fzfCfg registry = do+ let entries = labelledEntries registry+ candidates =+ [ Candidate+ { candidateDisplay =+ kindLabel kind+ <> " "+ <> entry.name.unModuleName+ <> maybe "" (\d -> " " <> d) entry.description+ <> if null entry.tags then "" else " [" <> T.intercalate ", " entry.tags <> "]",+ candidateValue = entry+ }+ | (kind, entry) <- entries+ ]+ opts = withPrompt "entry> " <> withHeight "40%" <> withAnsi <> withNoSort+ result <- runEff $ runFzfIO fzfCfg $ selectOne opts candidates+ case result of+ FzfSelected entry -> pure [entry]+ FzfCancelled -> pure []+ FzfNoMatch -> pure []+ FzfError err -> do+ TIO.putStrLn $ "fzf error: " <> err+ promptModuleSelection registry++-- | Interactive module selection via numbered list.+promptModuleSelection :: Registry -> IO [RegistryEntry]+promptModuleSelection registry = do+ TIO.putStrLn ""+ TIO.putStrLn $ registry.repoName+ case registry.repoDescription of+ Just desc -> TIO.putStrLn $ " " <> desc+ Nothing -> pure ()+ TIO.putStrLn ""+ TIO.putStrLn "Available modules, recipes, blueprints, and prompts:"+ let entries = zip [1 :: Int ..] (labelledEntries registry)+ mapM_+ ( \(i, (kind, entry)) ->+ TIO.putStrLn $+ " "+ <> T.pack (show i)+ <> ") "+ <> kindLabel kind+ <> " "+ <> entry.name.unModuleName+ <> maybe "" (\d -> " - " <> d) entry.description+ )+ entries+ TIO.putStrLn ""+ TIO.putStr "Select entries (comma-separated numbers, or 'all'): "+ hFlush stdout+ input <- TIO.getLine+ let trimmed = T.strip input+ let entryList = allEntries registry+ if T.toLower trimmed == "all"+ then pure entryList+ else do+ let nums = map (readMaybe . T.unpack . T.strip) (T.splitOn "," trimmed)+ if any (== Nothing) nums+ then do+ TIO.putStrLn "Invalid input. Please enter numbers separated by commas."+ pure []+ else do+ let indices = map (\(Just n) -> n) nums+ maxIdx = length entryList+ valid = all (\n -> n >= 1 && n <= maxIdx) indices+ if not valid+ then do+ TIO.putStrLn $ "Invalid selection. Please enter numbers between 1 and " <> T.pack (show maxIdx) <> "."+ pure []+ else pure [entryList !! (n - 1) | n <- indices]++-- | Install a single registry entry (module, recipe, blueprint, or prompt).+installRegistryEntry :: FilePath -> Text -> Text -> RegistryEntry -> IO Bool+installRegistryEntry cloneDir source repoName entry = do+ let entryDir = cloneDir </> entry.path+ name = T.unpack entry.name.unModuleName+ moduleDhall = entryDir </> "module.dhall"+ recipeDhall = entryDir </> "recipe.dhall"+ blueprintDhall = entryDir </> "blueprint.dhall"+ promptDhall = entryDir </> "prompt.dhall"+ TIO.putStrLn $ " Installing " <> entry.name.unModuleName <> "..."++ hasModule <- doesFileExist moduleDhall+ if hasModule+ then do+ decoded <- evalModuleFromFile moduleDhall+ case decoded of+ Left err -> do+ logIO LogNormal $ do+ logError $ " failed to load " <> entry.name.unModuleName <> ": " <> T.pack (show err)+ pure False+ Right modul -> do+ result <- validateModule entryDir modul+ case result of+ Left (ValidationError _ errors) -> do+ logIO LogNormal $ do+ logError $ " " <> entry.name.unModuleName <> " has validation errors:"+ mapM_ (\e -> logError $ " - " <> e) errors+ pure False+ Left err -> do+ logIO LogNormal (logError $ " " <> T.pack (show err))+ pure False+ Right _ -> do+ let ver = entry.version <|> modul.version+ installModuleDir entryDir name source (Just repoName) ver entry.tags+ TIO.putStrLn $ " Installed as: " <> T.pack name+ pure True+ else do+ hasRecipe <- doesFileExist recipeDhall+ if hasRecipe+ then do+ installModuleDir entryDir name source (Just repoName) entry.version entry.tags+ TIO.putStrLn $ " Installed recipe as: " <> T.pack name+ pure True+ else do+ hasBlueprint <- doesFileExist blueprintDhall+ if hasBlueprint+ then do+ decoded <- evalBlueprintFromFile blueprintDhall+ case decoded of+ Left err -> do+ logIO LogNormal $ do+ logError $ " failed to load " <> entry.name.unModuleName <> ": " <> T.pack (show err)+ pure False+ Right bp -> do+ let bpVersion = case bp of Blueprint _ v _ _ _ _ _ _ _ _ -> v+ ver = entry.version <|> bpVersion+ installModuleDir entryDir name source (Just repoName) ver entry.tags+ TIO.putStrLn $ " Installed blueprint as: " <> T.pack name+ pure True+ else do+ hasPrompt <- doesFileExist promptDhall+ if hasPrompt+ then do+ decoded <- evalAgentPromptFromFile promptDhall+ case decoded of+ Left err -> do+ logIO LogNormal $ do+ logError $ " failed to load " <> entry.name.unModuleName <> ": " <> T.pack (show err)+ pure False+ Right prompt -> do+ result <- validateAgentPrompt entryDir prompt+ case result of+ Left (ValidationError _ errors) -> do+ logIO LogNormal $ do+ logError $ " " <> entry.name.unModuleName <> " has validation errors:"+ mapM_ (\e -> logError $ " - " <> e) errors+ pure False+ Left err -> do+ logIO LogNormal (logError $ " " <> T.pack (show err))+ pure False+ Right _ -> do+ let ver = entry.version <|> prompt.version+ installModuleDir entryDir name source (Just repoName) ver entry.tags+ TIO.putStrLn $ " Installed prompt as: " <> T.pack name+ pure True+ else do+ logIO LogNormal $ do+ logError $ " entry '" <> entry.name.unModuleName <> "' has no supported runnable Dhall file at " <> T.pack entry.path+ pure False++readMaybe :: String -> Maybe Int+readMaybe s = case reads s of+ [(n, "")] -> Just n+ _ -> Nothing
+ src-exe/Seihou/CLI/Kit.hs view
@@ -0,0 +1,51 @@+module Seihou.CLI.Kit+ ( KitCommand (..),+ kitCommandParser,+ seihouKitConfig,+ runKit,+ )+where++import Baikai.Interactive (InteractiveProvider (..))+import Baikai.Kit.Command qualified as Kit+import Baikai.Kit.Config (KitConfig (..), KitScope (..))+import Options.Applicative (Parser)+import Seihou.Prelude++data KitCommand+ = KitList+ | KitInstall !Text !KitScope+ | KitUpdate !(Maybe Text)+ | KitUninstall !Text !KitScope+ | KitStatus+ deriving stock (Eq, Show)++kitCommandParser :: Parser KitCommand+kitCommandParser = fromShared <$> Kit.kitCommandParser++seihouKitConfig :: KitConfig+seihouKitConfig =+ KitConfig+ { toolName = "seihou",+ repoUrl = "https://github.com/shinzui/seihou-kit.git",+ providers = [InteractiveClaude, InteractiveCodex]+ }++runKit :: KitCommand -> IO ()+runKit = Kit.runKit seihouKitConfig . toShared++fromShared :: Kit.KitCommand -> KitCommand+fromShared = \case+ Kit.KitList -> KitList+ Kit.KitInstall name scope -> KitInstall name scope+ Kit.KitUpdate name -> KitUpdate name+ Kit.KitUninstall name scope -> KitUninstall name scope+ Kit.KitStatus -> KitStatus++toShared :: KitCommand -> Kit.KitCommand+toShared = \case+ KitList -> Kit.KitList+ KitInstall name scope -> Kit.KitInstall name scope+ KitUpdate name -> Kit.KitUpdate name+ KitUninstall name scope -> Kit.KitUninstall name scope+ KitStatus -> Kit.KitStatus
+ src-exe/Seihou/CLI/NewBlueprint.hs view
@@ -0,0 +1,69 @@+module Seihou.CLI.NewBlueprint+ ( handleNewBlueprint,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (NewBlueprintOpts (..))+import Seihou.CLI.SchemaVersion (schemaHash, schemaUrl)+import Seihou.CLI.Shared (logIO)+import Seihou.Core.Scaffold (blueprintDhall, examplePromptMarkdown)+import Seihou.Core.Types (LogLevel (..))+import Seihou.Effect.Logger (logError)+import Seihou.Prelude+import System.Directory (createDirectoryIfMissing, doesDirectoryExist)+import System.Exit (exitFailure)++handleNewBlueprint :: NewBlueprintOpts -> IO ()+handleNewBlueprint nopts = do+ let name = nopts.newBlueprintName++ -- Validate blueprint name format+ if not (isValidBlueprintName name)+ then do+ logIO LogNormal $ do+ logError $ "invalid blueprint name '" <> name <> "'."+ logError "Blueprint names must match [a-z][a-z0-9-]*."+ exitFailure+ else pure ()++ -- Determine output directory+ let outputDir = case nopts.newBlueprintPath of+ Just p -> p+ Nothing -> T.unpack name++ -- Refuse to overwrite an existing directory+ exists <- doesDirectoryExist outputDir+ if exists+ then do+ logIO LogNormal (logError $ "directory '" <> T.pack outputDir <> "' already exists.")+ exitFailure+ else pure ()++ -- Create directory structure (output dir + empty files/ subdir)+ createDirectoryIfMissing True (outputDir </> "files")++ -- Write blueprint.dhall+ let dhallContent = blueprintDhall name schemaUrl schemaHash+ writeFile (outputDir </> "blueprint.dhall") (T.unpack dhallContent)+ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "blueprint.dhall")++ -- Write prompt.md+ writeFile (outputDir </> "prompt.md") (T.unpack examplePromptMarkdown)+ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "prompt.md")++ -- Announce the empty files/ subdir so the user knows it is intentional+ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "files/")++ TIO.putStrLn $ "Blueprint '" <> name <> "' created at " <> T.pack outputDir <> "/"++-- | Check if a blueprint name matches [a-z][a-z0-9-]*. Mirrors+-- 'Seihou.CLI.NewModule.isValidModuleName' so the rule stays a single+-- source of truth across all three runnable kinds.+isValidBlueprintName :: Text -> Bool+isValidBlueprintName t = case T.uncons t of+ Nothing -> False+ Just (c, rest) ->+ (c >= 'a' && c <= 'z')+ && T.all (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-') rest
+ src-exe/Seihou/CLI/NewModule.hs view
@@ -0,0 +1,65 @@+module Seihou.CLI.NewModule+ ( handleNewModule,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (NewModuleOpts (..))+import Seihou.CLI.SchemaVersion (schemaHash, schemaUrl)+import Seihou.CLI.Shared (logIO)+import Seihou.Core.Scaffold (moduleDhall, readmeTemplate)+import Seihou.Core.Types (LogLevel (..))+import Seihou.Effect.Logger (logError)+import Seihou.Prelude+import System.Directory (createDirectoryIfMissing, doesDirectoryExist)+import System.Exit (exitFailure)++handleNewModule :: NewModuleOpts -> IO ()+handleNewModule nopts = do+ let name = nopts.newModuleName++ -- Validate module name format+ if not (isValidModuleName name)+ then do+ logIO LogNormal $ do+ logError $ "invalid module name '" <> name <> "'."+ logError "Module names must match [a-z][a-z0-9-]*."+ exitFailure+ else pure ()++ -- Determine output directory+ let outputDir = case nopts.newModulePath of+ Just p -> p+ Nothing -> T.unpack name++ -- Check that the target directory does not already exist+ exists <- doesDirectoryExist outputDir+ if exists+ then do+ logIO LogNormal (logError $ "directory '" <> T.pack outputDir <> "' already exists.")+ exitFailure+ else pure ()++ -- Create directory structure+ createDirectoryIfMissing True (outputDir </> "files")++ -- Write module.dhall+ let dhallContent = moduleDhall name schemaUrl schemaHash+ writeFile (outputDir </> "module.dhall") (T.unpack dhallContent)+ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "module.dhall")++ -- Write files/README.md.tpl+ let templateContent = readmeTemplate+ writeFile (outputDir </> "files" </> "README.md.tpl") (T.unpack templateContent)+ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "files" </> "README.md.tpl")++ TIO.putStrLn $ "Module '" <> name <> "' created at " <> T.pack outputDir <> "/"++-- | Check if a module name matches [a-z][a-z0-9-]*+isValidModuleName :: Text -> Bool+isValidModuleName t = case T.uncons t of+ Nothing -> False+ Just (c, rest) ->+ (c >= 'a' && c <= 'z')+ && T.all (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-') rest
+ src-exe/Seihou/CLI/NewPrompt.hs view
@@ -0,0 +1,52 @@+module Seihou.CLI.NewPrompt+ ( handleNewPrompt,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (NewPromptOpts (..))+import Seihou.CLI.SchemaVersion (schemaHash, schemaUrl)+import Seihou.CLI.Shared (logIO)+import Seihou.Core.Module (isValidModuleName)+import Seihou.Core.Scaffold (exampleAgentPromptMarkdown, promptDhall)+import Seihou.Core.Types (LogLevel (..))+import Seihou.Effect.Logger (logError)+import Seihou.Prelude+import System.Directory (createDirectoryIfMissing, doesDirectoryExist)+import System.Exit (exitFailure)++handleNewPrompt :: NewPromptOpts -> IO ()+handleNewPrompt nopts = do+ let name = nopts.newPromptName++ if not (isValidModuleName name)+ then do+ logIO LogNormal $ do+ logError $ "invalid prompt name '" <> name <> "'."+ logError "Prompt names must match [a-z][a-z0-9-]*."+ exitFailure+ else pure ()++ let outputDir = case nopts.newPromptPath of+ Just p -> p+ Nothing -> T.unpack name++ exists <- doesDirectoryExist outputDir+ if exists+ then do+ logIO LogNormal (logError $ "directory '" <> T.pack outputDir <> "' already exists.")+ exitFailure+ else pure ()++ createDirectoryIfMissing True (outputDir </> "files")++ let dhallContent = promptDhall name schemaUrl schemaHash+ writeFile (outputDir </> "prompt.dhall") (T.unpack dhallContent)+ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "prompt.dhall")++ writeFile (outputDir </> "prompt.md") (T.unpack exampleAgentPromptMarkdown)+ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "prompt.md")++ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "files/")+ TIO.putStrLn $ "Prompt '" <> name <> "' created at " <> T.pack outputDir <> "/"
+ src-exe/Seihou/CLI/NewRecipe.hs view
@@ -0,0 +1,85 @@+module Seihou.CLI.NewRecipe+ ( handleNewRecipe,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (NewRecipeOpts (..))+import Seihou.CLI.Shared (logIO)+import Seihou.Core.Types (LogLevel (..))+import Seihou.Effect.Logger (logError)+import Seihou.Prelude+import System.Directory (createDirectoryIfMissing, doesDirectoryExist)+import System.Exit (exitFailure)++handleNewRecipe :: NewRecipeOpts -> IO ()+handleNewRecipe ropts = do+ let name = ropts.newRecipeName++ -- Validate recipe name format+ if not (isValidRecipeName name)+ then do+ logIO LogNormal $ do+ logError $ "invalid recipe name '" <> name <> "'."+ logError "Recipe names must match [a-z][a-z0-9-]*."+ exitFailure+ else pure ()++ -- Determine output directory+ let outputDir = case ropts.newRecipePath of+ Just p -> p+ Nothing -> T.unpack name++ -- Check that the target directory does not already exist+ exists <- doesDirectoryExist outputDir+ if exists+ then do+ logIO LogNormal (logError $ "directory '" <> T.pack outputDir <> "' already exists.")+ exitFailure+ else pure ()++ -- Create directory+ createDirectoryIfMissing True outputDir++ -- Write recipe.dhall+ let dhallContent = recipeDhall name ropts.newRecipeModules+ writeFile (outputDir </> "recipe.dhall") (T.unpack dhallContent)+ TIO.putStrLn $ "Created " <> T.pack (outputDir </> "recipe.dhall")++ TIO.putStrLn $ "Recipe '" <> name <> "' created at " <> T.pack outputDir <> "/"++-- | Check if a recipe name matches [a-z][a-z0-9-]*+isValidRecipeName :: Text -> Bool+isValidRecipeName t = case T.uncons t of+ Nothing -> False+ Just (c, rest) ->+ (c >= 'a' && c <= 'z')+ && T.all (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-') rest++-- | Generate recipe.dhall content.+recipeDhall :: Text -> [Text] -> Text+recipeDhall name mods =+ "{ name = \""+ <> name+ <> "\"\n"+ <> ", version = Some \"0.1.0\"\n"+ <> ", description = Some \"\"\n"+ <> ", modules =\n"+ <> modulesSection mods+ <> ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n"+ <> ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n"+ <> "}\n"++modulesSection :: [Text] -> Text+modulesSection [] =+ " [] : List { module : Text, vars : List { name : Text, value : Text } }\n"+modulesSection mods =+ " [ "+ <> T.intercalate "\n , " (map formatModEntry mods)+ <> "\n ]\n"+ where+ formatModEntry m =+ "{ module = \""+ <> m+ <> "\", vars = [] : List { name : Text, value : Text } }"
+ src-exe/Seihou/CLI/Outdated.hs view
@@ -0,0 +1,218 @@+module Seihou.CLI.Outdated+ ( handleOutdated,+ checkInstalledModulesForUpdates,+ readOriginWithModule,+ moduleNameFromDm,+ checkSource,+ )+where++import Control.Exception (SomeException, try)+import Data.Aeson qualified as Aeson+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (OutdatedOpts (..))+import Seihou.CLI.InstallShared (OriginInfo (..))+import Seihou.CLI.RemoteVersion (fetchTrueModuleVersion)+import Seihou.CLI.Style (dim, green, red, useColor, yellow)+import Seihou.CLI.VersionCompare+ ( CheckStats (..),+ OutdatedEntry (..),+ OutdatedStatus (..),+ compareVersions,+ )+import Seihou.Core.Install (parseModuleName)+import Seihou.Core.Module (DiscoveredModule (..), ModuleSource (..), defaultSearchPaths, discoverAllModules)+import Seihou.Core.Types (Module (..), ModuleName (..))+import Seihou.Prelude+import System.Directory (doesFileExist)+import System.Exit (ExitCode (..))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readProcessWithExitCode)++handleOutdated :: OutdatedOpts -> IO ()+handleOutdated oopts = do+ searchPaths <- defaultSearchPaths+ modules <- discoverAllModules searchPaths+ let installed = filter (\dm -> dm.discoveredSource == SourceInstalled) modules++ if null installed+ then TIO.putStrLn "No installed modules found."+ else do+ (entries, _stats) <- checkInstalledModulesForUpdates installed+ if null entries+ then TIO.putStrLn "No installed modules with origin metadata found."+ else+ if oopts.outdatedJson+ then LBS.putStr (encodePretty entries)+ else renderTable entries++-- | Check a list of already-discovered modules for updates.+--+-- Filters to @SourceInstalled@ modules internally, reads @.seihou-origin.json@+-- for each, groups by source URL, clones each source shallowly, and compares+-- installed versions against what the remote registry advertises.+--+-- Prints progress lines to stdout via 'checkSource'. Returns the flat list+-- of outdated entries plus stats describing how many modules were actually+-- checked versus skipped for lack of origin metadata.+checkInstalledModulesForUpdates ::+ [DiscoveredModule] ->+ IO ([OutdatedEntry], CheckStats)+checkInstalledModulesForUpdates modules = do+ let installed = filter (\dm -> dm.discoveredSource == SourceInstalled) modules+ originsWithModules <- mapM readOriginWithModule installed+ let withOrigins = [(dm, origin) | (dm, Just origin) <- originsWithModules]+ skipped = length installed - length withOrigins+ if null withOrigins+ then+ pure+ ( [],+ CheckStats {checkedCount = 0, skippedNoOrigin = skipped}+ )+ else do+ let grouped =+ Map.toList $+ Map.fromListWith+ (++)+ [(origin.sourceUrl, [(dm, origin)]) | (dm, origin) <- withOrigins]+ TIO.putStrLn "Checking installed modules for updates..."+ entries <- concat <$> mapM checkSource grouped+ pure+ ( entries,+ CheckStats {checkedCount = length entries, skippedNoOrigin = skipped}+ )++-- | Read origin info from a discovered module's directory.+readOriginWithModule :: DiscoveredModule -> IO (DiscoveredModule, Maybe OriginInfo)+readOriginWithModule dm = do+ let originFile = dm.discoveredDir </> ".seihou-origin.json"+ exists <- doesFileExist originFile+ if exists+ then do+ bs <- LBS.readFile originFile+ case Aeson.decode bs of+ Just info -> pure (dm, Just info)+ Nothing -> pure (dm, Nothing)+ else pure (dm, Nothing)++-- | Check a single source URL for updates. Clones the repo and compares versions.+--+-- The comparison must happen inside 'withSystemTempDirectory' because+-- 'fetchTrueModuleVersion' reads @module.dhall@ off disk. If we returned+-- the clone path to the caller, the temp directory would already be gone+-- by the time the Dhall read ran, and every module would resolve to+-- @Nothing@ (appearing as \"unversioned\").+checkSource :: (Text, [(DiscoveredModule, OriginInfo)]) -> IO [OutdatedEntry]+checkSource (sourceUrl, modulesWithOrigins) = do+ let repoName = parseModuleName sourceUrl+ TIO.putStrLn $ " Cloning " <> T.pack repoName <> "..."++ result <- try $ withSystemTempDirectory "seihou-outdated" $ \tmpDir -> do+ let cloneDir = tmpDir </> repoName+ (exitCode, _stdout, _stderr) <- readProcessWithExitCode "git" ["clone", "--depth", "1", T.unpack sourceUrl, cloneDir] ""+ case exitCode of+ ExitFailure _ -> pure Nothing+ ExitSuccess ->+ Just <$> mapM (compareModule cloneDir) modulesWithOrigins++ case result of+ Left (_ :: SomeException) ->+ pure [mkUnreachable dm origin | (dm, origin) <- modulesWithOrigins]+ Right Nothing ->+ pure [mkUnreachable dm origin | (dm, origin) <- modulesWithOrigins]+ Right (Just entries) -> pure entries++-- | Compare a single installed module against the remote contents.+compareModule :: FilePath -> (DiscoveredModule, OriginInfo) -> IO OutdatedEntry+compareModule cloneDir (dm, origin) = do+ let name = moduleNameFromDm dm+ installedVer = origin.version+ availableVer <- fetchAvailable cloneDir (ModuleName name)+ let status = compareVersions installedVer availableVer+ pure+ OutdatedEntry+ { moduleName = name,+ installedVersion = installedVer,+ availableVersion = availableVer,+ status = status+ }++-- | Look up the available version of a module in a cloned repo. Wraps+-- 'fetchTrueModuleVersion' so that fetch errors collapse to @Nothing@ for+-- the consumer-facing comparison; downstream renderers display this as+-- "unversioned".+fetchAvailable :: FilePath -> ModuleName -> IO (Maybe Text)+fetchAvailable cloneDir name = do+ result <- fetchTrueModuleVersion cloneDir name+ case result of+ Right v -> pure v+ Left _ -> pure Nothing++-- | Compare installed and available version strings.+-- | Extract the module name text from a DiscoveredModule.+moduleNameFromDm :: DiscoveredModule -> Text+moduleNameFromDm dm = case dm.discoveredResult of+ Right m -> m.name.unModuleName+ Left _ -> dirName dm.discoveredDir++-- | Extract the last path component as a name.+dirName :: FilePath -> Text+dirName path = case reverse (T.splitOn "/" (T.pack path)) of+ (name : _) -> name+ [] -> T.pack path++-- | Create an unreachable entry for a module.+mkUnreachable :: DiscoveredModule -> OriginInfo -> OutdatedEntry+mkUnreachable dm origin =+ OutdatedEntry+ { moduleName = moduleNameFromDm dm,+ installedVersion = origin.version,+ availableVersion = Nothing,+ status = Unreachable+ }++-- | Render the outdated report as a table.+renderTable :: [OutdatedEntry] -> IO ()+renderTable entries = do+ colorEnabled <- useColor+ let maxNameLen = max 6 (maximum (map (T.length . (.moduleName)) entries))+ maxInstLen = max 9 (maximum (map (T.length . maybe "(none)" id . (.installedVersion)) entries))+ maxAvailLen = max 9 (maximum (map (T.length . maybe "(none)" id . (.availableVersion)) entries))++ padR n t = t <> T.replicate (n - T.length t + 2) " "++ header =+ padR maxNameLen "Module"+ <> padR maxInstLen "Installed"+ <> padR maxAvailLen "Available"+ <> "Status"++ formatRow e =+ let instText = maybe "(none)" id e.installedVersion+ availText = maybe "(none)" id e.availableVersion+ statusTxt = case e.status of+ UpToDate -> if colorEnabled then green "up to date" else "up to date"+ OutdatedSt -> if colorEnabled then red "outdated" else "outdated"+ Unversioned -> if colorEnabled then dim "unversioned" else "unversioned"+ Unreachable -> if colorEnabled then yellow "unreachable" else "unreachable"+ in padR maxNameLen e.moduleName+ <> padR maxInstLen instText+ <> padR maxAvailLen availText+ <> statusTxt++ TIO.putStrLn ""+ TIO.putStrLn header+ mapM_ (TIO.putStrLn . formatRow) entries++ let total = length entries+ outdated = length (filter (\e -> e.status == OutdatedSt) entries)+ TIO.putStrLn ""+ TIO.putStrLn $+ T.pack (show total)+ <> " module(s) checked, "+ <> T.pack (show outdated)+ <> " outdated."
+ src-exe/Seihou/CLI/PromptRun.hs view
@@ -0,0 +1,189 @@+module Seihou.CLI.PromptRun+ ( handlePromptRun,+ )+where++import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.CLI.AgentCompletion (AgentModelConfig)+import Seihou.CLI.AgentLaunch (gatherAgentContext, setupAllowedTools)+import Seihou.CLI.AgentRun (runRenderedAgentPrompt)+import Seihou.CLI.Commands (PromptRunOpts (..))+import Seihou.CLI.PromptRender (renderPromptBody, renderPromptSystemPrompt)+import Seihou.CLI.Shared+ ( deriveNamespace,+ formatVarError,+ logIO,+ toVarNameMap,+ unwrapConfig,+ )+import Seihou.Composition.Instance (primaryInstance)+import Seihou.Composition.Resolve (resolveWithPrompts)+import Seihou.Core.AgentPrompt (validateAgentPrompt)+import Seihou.Core.CommandVar (resolveCommandVars)+import Seihou.Core.Context (resolveContext)+import Seihou.Core.Module (defaultSearchPaths, discoverRunnable)+import Seihou.Core.Types+import Seihou.Effect.ConfigReader+ ( readContextConfig,+ readGlobalConfig,+ readLocalConfig,+ readNamespaceConfig,+ )+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Effect.ConsoleInterp (runConsole)+import Seihou.Effect.Logger (logError)+import Seihou.Effect.ProcessInterp (runProcessIO)+import Seihou.Prelude+import System.Environment (getEnvironment)+import System.Exit (exitFailure)++handlePromptRun :: AgentModelConfig -> PromptRunOpts -> IO ()+handlePromptRun modelConfig opts = do+ let level = if opts.runPromptVerbose then LogVerbose else LogNormal++ searchPaths <- defaultSearchPaths+ runnableResult <- discoverRunnable searchPaths opts.runPromptName+ (prompt, promptDir) <- case runnableResult of+ Right (RunnableAgentPrompt p dir) -> pure (p, dir)+ Right (RunnableModule _ _) ->+ exitErr level $+ "'"+ <> opts.runPromptName.unModuleName+ <> "' is a module, not a prompt. Did you mean 'seihou run "+ <> opts.runPromptName.unModuleName+ <> "'?"+ Right (RunnableRecipe _ _) ->+ exitErr level $+ "'"+ <> opts.runPromptName.unModuleName+ <> "' is a recipe, not a prompt. Did you mean 'seihou run "+ <> opts.runPromptName.unModuleName+ <> "'?"+ Right (RunnableBlueprint _ _) ->+ exitErr level $+ "'"+ <> opts.runPromptName.unModuleName+ <> "' is a blueprint, not a prompt. Did you mean 'seihou agent run "+ <> opts.runPromptName.unModuleName+ <> "'?"+ Left err -> exitErr level (renderModuleLoadError err)++ validation <- validateAgentPrompt promptDir prompt+ case validation of+ Left err -> exitErr level (renderModuleLoadError err)+ Right _ -> pure ()++ let placeholderModule =+ Module+ { name = prompt.name,+ version = prompt.version,+ description = prompt.description,+ vars = relaxCommandVarDecls prompt.commandVars prompt.vars,+ exports = [],+ prompts = prompt.prompts,+ steps = [],+ commands = [],+ dependencies = [],+ removal = Nothing,+ migrations = []+ }+ placeholderInst = primaryInstance prompt.name+ placeholderTriple = (placeholderInst, placeholderModule, promptDir)++ envPairs <- getEnvironment+ let cliOverrides = Map.fromList [(VarName k, v) | (k, v) <- opts.runPromptVars]+ envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]+ namespace = fromMaybe (deriveNamespace prompt.name) opts.runPromptNamespace+ context <- resolveContext opts.runPromptContext envVars+ let contextName = fromMaybe "" context++ resolveResult <- runEff $ runConfigReader $ runConsole $ do+ localCfg <- readLocalConfig >>= unwrapConfig level+ nsCfg <- readNamespaceConfig namespace >>= unwrapConfig level+ ctxCfg <- readContextConfig contextName >>= unwrapConfig level+ gCfg <- readGlobalConfig >>= unwrapConfig level+ resolveWithPrompts+ [placeholderTriple]+ cliOverrides+ envVars+ namespace+ contextName+ (toVarNameMap localCfg)+ (toVarNameMap nsCfg)+ (toVarNameMap ctxCfg)+ (toVarNameMap gCfg)++ resolvedNormal <- case resolveResult of+ Left errs -> do+ logIO level $ do+ logError "Error resolving prompt variables:"+ mapM_ (logError . (" " <>) . formatVarError) errs+ exitFailure+ Right r -> pure (Map.findWithDefault Map.empty placeholderInst r)++ commandResult <- runEff $ runProcessIO $ resolveCommandVars prompt.vars prompt.commandVars resolvedNormal+ resolved <- case commandResult of+ Left errs -> do+ logIO level $ do+ logError "Error resolving command variables:"+ mapM_ (logError . (" " <>) . formatVarError) errs+ exitFailure+ Right r -> pure r++ let renderedPrompt = renderPromptBody resolved prompt.prompt+ ctx <- gatherAgentContext+ let systemPrompt = renderPromptSystemPrompt ctx prompt resolved renderedPrompt opts.runPromptPrompt++ _ <-+ runRenderedAgentPrompt+ opts.runPromptDebug+ modelConfig+ setupAllowedTools+ Nothing+ systemPrompt+ opts.runPromptPrompt+ pure ()++relaxCommandVarDecls :: [CommandVar] -> [VarDecl] -> [VarDecl]+relaxCommandVarDecls commandVars =+ map relaxOne+ where+ commandNames = Set.fromList (map (.name) commandVars)+ relaxOne decl+ | Set.member decl.name commandNames = decl {required = False}+ | otherwise = decl++exitErr :: LogLevel -> Text -> IO a+exitErr level msg = do+ logIO level (logError msg)+ exitFailure++renderModuleLoadError :: ModuleLoadError -> Text+renderModuleLoadError = \case+ ModuleNotFound name searched ->+ "Prompt '"+ <> name.unModuleName+ <> "' not found. Searched in:\n"+ <> T.intercalate "\n" (map ((" " <>) . T.pack) searched)+ DhallEvalError name msg ->+ "Failed to evaluate '" <> name.unModuleName <> "': " <> msg+ DhallDecodeError name msg ->+ "Failed to decode '" <> name.unModuleName <> "': " <> msg+ ValidationError name msgs ->+ "Validation failed for '"+ <> name.unModuleName+ <> "':\n"+ <> T.intercalate "\n" (map (" " <>) msgs)+ CircularDependency names ->+ "Circular dependency detected: "+ <> T.intercalate " -> " (map (.unModuleName) names)+ MissingSourceFile name path ->+ "Missing source file in '"+ <> name.unModuleName+ <> "': "+ <> T.pack path+ RegistryEvalError path msg ->+ "Failed to evaluate registry at '" <> path <> "': " <> msg
+ src-exe/Seihou/CLI/Remove.hs view
@@ -0,0 +1,194 @@+module Seihou.CLI.Remove+ ( handleRemove,+ )+where++import Control.Monad (foldM, when)+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Data.Time.Clock (getCurrentTime)+import Seihou.CLI.Commands (RemoveOpts (..))+import Seihou.CLI.Style (bold, dim, green, useColor, yellow)+import Seihou.Core.Types+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.ManifestStore (readManifest, writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Engine.Remove+import Seihou.Prelude+import System.Exit (ExitCode (..), exitFailure, exitWith)+import System.IO (hFlush, hIsTerminalDevice, stdin, stdout)++handleRemove :: RemoveOpts -> IO ()+handleRemove opts = do+ let manifestPath = ".seihou" </> "manifest.json"+ modName = opts.removeModule++ -- Read the manifest+ manifestResult <- runEff $ runFilesystem $ runManifestStore manifestPath readManifest+ manifest <- case manifestResult of+ Left err -> do+ TIO.putStrLn $ "Error reading manifest: " <> err+ exitFailure+ Right Nothing -> do+ TIO.putStrLn "No Seihou manifest found. Nothing to remove."+ exitFailure+ Right (Just m) -> pure m++ -- Find the module's removal spec+ let mApplied = findAppliedModule manifest modName+ case mApplied of+ Nothing -> do+ TIO.putStrLn $ "Module '" <> modName.unModuleName <> "' is not applied in this project."+ exitFailure+ Just am -> case am.removal of+ Nothing -> do+ TIO.putStrLn $+ "Module '"+ <> modName.unModuleName+ <> "' has no removal spec. Add a 'removal' section to its module.dhall to make it removable."+ exitFailure+ Just removal -> do+ -- Build removal plan from declared steps+ planResult <- runEff $ runFilesystem $ buildRemovalOps manifest modName removal+ plan <- case planResult of+ Left (ModuleNotApplied name) -> do+ TIO.putStrLn $ "Module '" <> name.unModuleName <> "' is not applied in this project."+ exitFailure+ Left (ModuleNotRemovable name) -> do+ TIO.putStrLn $+ "Module '"+ <> name.unModuleName+ <> "' has no removal spec."+ exitFailure+ Left (RemovalUnsafePath label path reason) -> do+ TIO.putStrLn $+ "Unsafe removal "+ <> label+ <> " '"+ <> path+ <> "': "+ <> reason+ exitFailure+ Right p -> pure p++ colorEnabled <- useColor++ -- Display plan+ TIO.putStrLn $ "Removal plan for " <> modName.unModuleName <> ":"++ if null plan.ops+ then TIO.putStrLn " (no removal operations)"+ else mapM_ (displayOp colorEnabled) plan.ops++ -- Dry run exits here+ when opts.removeDryRun $ do+ TIO.putStrLn ""+ TIO.putStrLn $ applyColor colorEnabled dim "(dry run — no changes made)"+ exitWith ExitSuccess++ -- Collect conflict files for interactive resolution+ let conflictFiles = [p | DeleteFileOp p RFConflict <- plan.ops]++ -- Resolve conflicts+ keepSet <-+ if null conflictFiles || opts.removeForce+ then pure Set.empty+ else do+ isInteractive <- hIsTerminalDevice stdin+ if not isInteractive+ then do+ TIO.putStrLn "Conflicted files found. Use --force to delete them non-interactively."+ exitFailure+ else resolveConflictsInteractively conflictFiles++ -- Prompt for confirmation (if there are any actionable ops)+ let actionableOps = [() | op <- plan.ops, isActionable op]+ when (not (null actionableOps)) $ do+ TIO.putStr "\n Proceed? [y/N] "+ hFlush stdout+ response <- T.strip . T.pack <$> getLine+ when (T.toLower response /= "y") $+ exitWith (ExitFailure 3)++ -- Execute removal+ now <- getCurrentTime+ updatedManifest <- runEff $ runFilesystem $ executeRemovalOps manifest plan keepSet now++ -- Write updated manifest+ runEff $ runFilesystem $ runManifestStore manifestPath $ writeManifest updatedManifest++ -- Report+ let deleted = length [() | DeleteFileOp _ s <- plan.ops, s /= RFGone, not (Set.member "" keepSet)]+ stripped = length [() | StripSectionOp _ <- plan.ops]+ commands = length [() | RemovalCommandOp _ _ <- plan.ops]+ TIO.putStrLn $+ applyColor colorEnabled green "✓"+ <> " Removed module "+ <> applyColor colorEnabled bold modName.unModuleName+ <> "."+ <> formatCounts deleted stripped commands++-- | Display a single removal operation.+displayOp :: Bool -> RemovalOp -> IO ()+displayOp c (DeleteFileOp path RFSafe) =+ TIO.putStrLn $ " " <> applyColor c green "Delete" <> " " <> T.pack path <> applyColor c dim " (unchanged)"+displayOp c (DeleteFileOp path RFConflict) =+ TIO.putStrLn $ " " <> applyColor c yellow "Delete" <> " " <> T.pack path <> applyColor c yellow " (modified by user)"+displayOp c (DeleteFileOp path RFGone) =+ TIO.putStrLn $ " " <> applyColor c dim "Skip" <> " " <> T.pack path <> applyColor c dim " (already deleted)"+displayOp c (StripSectionOp path) =+ TIO.putStrLn $ " " <> applyColor c green "Strip" <> " " <> T.pack path <> applyColor c dim " (remove section)"+displayOp c (RewriteOp path _) =+ TIO.putStrLn $ " " <> applyColor c green "Rewrite" <> " " <> T.pack path+displayOp c (RemovalCommandOp cmd _) =+ TIO.putStrLn $ " " <> applyColor c green "Run" <> " " <> cmd++-- | Check if a removal op does something (not just skip).+isActionable :: RemovalOp -> Bool+isActionable (DeleteFileOp _ RFGone) = False+isActionable _ = True++-- | Format a summary of counts.+formatCounts :: Int -> Int -> Int -> Text+formatCounts 0 0 0 = ""+formatCounts d s c =+ " "+ <> T.intercalate+ ", "+ ( filter+ (not . T.null)+ [ if d > 0 then T.pack (show d) <> " file" <> plural d <> " deleted" else "",+ if s > 0 then T.pack (show s) <> " section" <> plural s <> " stripped" else "",+ if c > 0 then T.pack (show c) <> " command" <> plural c <> " run" else ""+ ]+ )+ <> "."+ where+ plural n = if n /= 1 then "s" else ""++-- | Find an applied module by name in the manifest.+findAppliedModule :: Manifest -> ModuleName -> Maybe AppliedModule+findAppliedModule manifest modName =+ case filter (\am -> am.name == modName) manifest.modules of+ (am : _) -> Just am+ [] -> Nothing++-- | Ask the user about each conflicted file interactively.+resolveConflictsInteractively :: [FilePath] -> IO (Set.Set FilePath)+resolveConflictsInteractively paths = do+ TIO.putStrLn "\nThe following files have been modified since generation:"+ foldM askOne Set.empty paths+ where+ askOne keepSet path = do+ TIO.putStr $ " " <> T.pack path <> " — keep or delete? [k/d] "+ hFlush stdout+ response <- T.strip . T.toLower . T.pack <$> getLine+ if response == "k" || response == "keep"+ then pure (Set.insert path keepSet)+ else pure keepSet++-- | Apply a color function if colors are enabled.+applyColor :: Bool -> (Text -> Text) -> Text -> Text+applyColor True f t = f t+applyColor False _ t = t
+ src-exe/Seihou/CLI/Run.hs view
@@ -0,0 +1,633 @@+module Seihou.CLI.Run+ ( handleRun,+ )+where++import Control.Monad (foldM, unless, when)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, isJust)+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Data.Time (UTCTime)+import Data.Time.Clock (getCurrentTime)+import Seihou.CLI.Commands (RunOpts (..))+import Seihou.CLI.CommitMessage (generateCommitMessage)+import Seihou.CLI.Git (gitAdd, gitCheckIgnore, gitCommit, gitDiffCached, isGitRepo)+import Seihou.CLI.Migrate+ ( MigrateError (..),+ MigrateOpts (..),+ MigrateResult (..),+ runMigrate,+ )+import Seihou.CLI.PendingMigrations+ ( detectPendingMigrations,+ formatRefusalMessage,+ )+import Seihou.CLI.SavePrompted (collectPromptedValues, offerSavePrompted)+import Seihou.CLI.Shared (deriveNamespace, formatBlueprintRefusal, formatVarError, logIO, 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.Recipe (expandRecipe)+import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts)+import Seihou.Core.Context (resolveContext)+import Seihou.Core.Migration (MigrationPlan (..))+import Seihou.Core.Module (defaultSearchPaths, discoverRunnable)+import Seihou.Core.Types+import Seihou.Core.Variable (diagnoseResolution)+import Seihou.Core.Version (renderVersion)+import Seihou.Effect.ConfigReader (readContextConfig, readGlobalConfig, readLocalConfig, readNamespaceConfig)+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Effect.ConfigWriterInterp (runConfigWriter)+import Seihou.Effect.ConsoleInterp (runConsole)+import Seihou.Effect.Filesystem (createDirectoryIfMissing)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.FzfInterp (runFzfIO)+import Seihou.Effect.Logger (logDebug, logError, logInfo, logWarn)+import Seihou.Effect.ManifestStore (readManifest, writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Effect.Process (runProcess)+import Seihou.Effect.ProcessInterp (runProcessIO)+import Seihou.Engine.Conflict (resolveConflicts)+import Seihou.Engine.Diff (computeDiff)+import Seihou.Engine.Execute (executePlan)+import Seihou.Engine.Preview (buildPreview)+import Seihou.Fzf (FzfResult (..), detectFzfConfig, isFzfUsable)+import Seihou.Fzf.Selector (selectModule)+import Seihou.Interaction.Confirm (confirmDefaults)+import Seihou.Manifest.Types (currentManifestVersion, emptyManifest)+import Seihou.Prelude+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..), exitFailure, exitWith)+import System.FilePath (takeDirectory)+import System.IO (hFlush, hIsTerminalDevice, stdin, stdout)++handleRun :: RunOpts -> IO ()+handleRun runOpts = do+ let additional = runOpts.runAdditional+ level = if runOpts.runVerbose then LogVerbose else LogNormal++ -- 0. Resolve module name (from argument or fzf picker)+ modName <- case runOpts.runModule of+ Just name -> pure name+ Nothing -> do+ fzfCfg <- detectFzfConfig+ if isFzfUsable fzfCfg+ then do+ result <- runEff $ runFzfIO fzfCfg $ selectModule+ case result of+ FzfSelected name -> pure name+ FzfCancelled -> exitWith ExitSuccess+ FzfNoMatch -> do+ logIO level (logError "No modules found.")+ exitFailure+ FzfError err -> do+ logIO level (logError $ "fzf error: " <> err)+ exitFailure+ else do+ logIO level (logError "MODULE argument is required when fzf is not available.")+ exitFailure++ -- 0b. Recipe detection: check if the name resolves to a recipe or a module+ searchPaths <- defaultSearchPaths+ (primaryName, allAdditional, recipeOverrides, recipeInfo) <- do+ runnableResult <- discoverRunnable searchPaths modName+ case runnableResult of+ Right (RunnableRecipe recipe _recipeDir) -> do+ case expandRecipe recipe of+ Left errs -> do+ logIO level $+ logError $+ "Invalid recipe '"+ <> recipe.name.unRecipeName+ <> "': "+ <> T.intercalate "; " errs+ exitFailure+ Right (primary, recipeAdditional, overrides, _recipeVars, _recipePrompts) -> do+ logIO level $+ logInfo $+ "Recipe '" <> recipe.name.unRecipeName <> "' expanding to " <> T.pack (show (length recipe.modules)) <> " modules"+ pure (primary, recipeAdditional ++ additional, overrides, Just (recipe.name, recipe.version))+ Right (RunnableModule _ _) ->+ pure (modName, additional, Map.empty, Nothing)+ Right (RunnableBlueprint _b _blueprintDir) -> do+ -- Use the user-typed name (modName) rather than the blueprint's+ -- declared name. Discovery resolves by directory name; the+ -- suggested 'seihou agent run NAME' must match what the user+ -- can re-type to find the same artifact.+ logIO level $ logError (formatBlueprintRefusal modName)+ exitFailure+ Left _ ->+ -- Discovery failed — let loadComposition handle the error with its detailed message+ pure (modName, additional, Map.empty, Nothing)++ -- 1. Load all modules in the composition (primary + additional + transitive deps)+ compositionResult <- loadComposition searchPaths primaryName allAdditional+ modulesInOrder <- case compositionResult of+ Left (ModuleNotFound name searched) -> do+ logIO level $ do+ logError $ "Module '" <> name.unModuleName <> "' not found."+ logError "Searched in:"+ mapM_ (\p -> logError $ " " <> T.pack p) searched+ exitFailure+ Left (CircularDependency names) -> do+ logIO level $ do+ logError "Circular dependency detected:"+ logError $ " " <> T.intercalate " -> " (map (.unModuleName) names)+ exitFailure+ Left err -> exitError level (T.pack (show err))+ Right ms -> pure ms++ -- Report composition when multiple modules are involved+ when (length modulesInOrder > 1) $+ logIO level $ do+ logInfo $ "Composing " <> T.pack (show (length modulesInOrder)) <> " modules:"+ mapM_ (\(_, m, _) -> logInfo $ " " <> m.name.unModuleName) modulesInOrder++ -- 2. Resolve variables with export visibility and interactive prompts+ envPairs <- getEnvironment+ -- Merge recipe overrides with CLI overrides (CLI wins on conflict)+ let cliOverrides = Map.union (Map.fromList [(VarName k, v) | (k, v) <- runOpts.runVars]) recipeOverrides+ envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]+ namespace = fromMaybe (deriveNamespace primaryName) runOpts.runNamespace+ context <- resolveContext runOpts.runContext envVars+ let contextName = fromMaybe "" context+ (resolveResult, localMap, nsMap, ctxMap, globalMap) <- runEff $ runConfigReader $ runConsole $ do+ localCfg <- readLocalConfig >>= unwrapConfig level+ namespaceCfg <- readNamespaceConfig namespace >>= unwrapConfig level+ contextCfg <- readContextConfig contextName >>= unwrapConfig level+ globalCfg <- readGlobalConfig >>= unwrapConfig level+ let lm = toVarNameMap localCfg+ nm = toVarNameMap namespaceCfg+ cm = toVarNameMap contextCfg+ gm = toVarNameMap globalCfg+ r <- resolveWithPrompts modulesInOrder cliOverrides envVars namespace contextName lm nm cm gm+ pure (r, lm, nm, cm, gm)+ resolvedInitial <- case resolveResult of+ Left errs -> do+ logIO level $ do+ logError "Error resolving variables:"+ mapM_ (logError . (" " <>) . formatVarError) errs+ exitFailure+ Right r -> pure r++ -- 2a. Optionally confirm default-sourced values.+ resolved <-+ if runOpts.runConfirmDefaults+ then runEff $ runConsole $ confirmDefaults modulesInOrder resolvedInitial+ else pure resolvedInitial++ -- 2b. Emit diagnostics for unused config keys+ let allDecls = concatMap (\(_, m, _) -> m.vars) modulesInOrder+ allResolved = Map.unions [vs | vs <- Map.elems resolved]+ (unusedKeys, _) = diagnoseResolution allResolved allDecls localMap nsMap ctxMap globalMap+ when (not (null unusedKeys)) $+ logIO level $+ logWarn $+ "Config keys not matching any declared variable: "+ <> T.intercalate ", " (map (.unVarName) unusedKeys)++ -- 3. Compile composed plan (all modules merged)+ let quads =+ [ (inst, m, dir, Map.map (.value) (resolved Map.! inst))+ | (inst, m, dir) <- modulesInOrder+ ]+ planResult <- compileComposedPlan quads+ (ops, warnings, ownerMap) <- case planResult of+ Left errs -> do+ logIO level $ do+ logError "Errors compiling plan:"+ mapM_ (logError . (" " <>)) errs+ exitFailure+ Right r -> pure r++ -- 4. Filter out command ops if --no-commands+ let opsFiltered =+ if runOpts.runNoCommands+ then filter (not . isCommandOp) ops+ else ops++ -- 5. Print composition warnings+ mapM_ (printWarning level) warnings++ -- 6. Compute diff (shared by dry-run, --diff, and execution paths)+ now <- getCurrentTime+ let manifestPath = ".seihou" </> "manifest.json"+ planned =+ [(dest, content, modName, Nothing) | WriteFileOp dest content _ <- opsFiltered]+ ++ [(dest, content, mName, Just pOp) | PatchFileOp dest content pOp _ mName <- opsFiltered]++ -- 6a. Read the manifest before computing the diff so the pre-flight+ -- migration check can run against it (and, with --with-migrations, so+ -- 'runMigrate' can rewrite it before the diff is taken).+ existingRes <- runEff $ runFilesystem $ runManifestStore manifestPath $ do+ createDirectoryIfMissing True (takeDirectory manifestPath)+ readManifest+ initialManifest <- case existingRes of+ Left err -> do+ logIO level (logError $ "Error reading manifest: " <> err)+ exitFailure+ Right m -> pure (fromMaybe (emptyManifest now) m)++ -- 6b. Pre-flight pending-migration check. We only consider modules in+ -- the current composition: a pending chain on an unrelated module+ -- must not block this run.+ let composedModuleNames =+ Set.fromList [m.name | (_, m, _) <- modulesInOrder]+ pendings <-+ detectPendingMigrations initialManifest (Just composedModuleNames)+ manifest <-+ handlePendingMigrations level runOpts manifestPath initialManifest pendings++ -- 6c. Compute the diff against the (possibly post-migration) manifest.+ diff <- runEff $ runFilesystem $ runManifestStore manifestPath $ do+ -- Diff needs every name that could own a manifest file. Each+ -- instance owns its qualified name; the bare module name is still+ -- matched to cover manifest entries written before the schema bump.+ let composedNames =+ Set.fromList $+ concatMap (\(inst, _, _) -> [inst.instanceModule, qualifiedName inst]) modulesInOrder+ computeDiff manifest composedNames planned++ colorEnabled <- useColor++ let modNames = map (\(_, m, _) -> m.name) modulesInOrder+ allVarValues =+ Map.unions+ [Map.map (.value) vs | vs <- Map.elems resolved]+ preview = buildPreview opsFiltered (Just diff) ownerMap++ -- 6. Handle --dry-run: show plan view and exit+ if runOpts.runDryRun+ then+ TIO.putStr (formatPlanViewColor colorEnabled modNames allVarValues preview diff)+ else+ if runOpts.runDiff+ then TIO.putStr (formatDiff colorEnabled diff ownerMap)+ else do+ -- Show plan view+ TIO.putStr (formatPlanViewColor colorEnabled modNames allVarValues preview diff)++ -- Prompt for confirmation (skip if --force or non-interactive)+ interactive <- hIsTerminalDevice stdin+ when (interactive && not runOpts.runForce) $ do+ TIO.putStr "\n Proceed? [Y/n] "+ hFlush stdout+ response <- T.strip . T.pack <$> getLine+ when (response /= "" && T.toLower response /= "y") $+ exitWith (ExitFailure 3)++ -- Resolve conflicts interactively (or abort)+ resolutions <-+ runEff $+ runConsole $+ resolveConflicts runOpts.runForce diff.conflicts+ case resolutions of+ Nothing -> do+ TIO.putStrLn "Conflicts detected (use --force to overwrite):"+ mapM_ (\c -> TIO.putStrLn $ " ! " <> T.pack c.path) diff.conflicts+ exitFailure+ Just conflictResolved -> do+ -- Partition resolutions: accept (overwrite), keep (update manifest only), skip (ignore)+ let keepRecords =+ Map.fromList+ [ ( c.path,+ case Map.lookup c.path manifest.files of+ Just existing ->+ existing {hash = c.diskHash, generatedAt = now}+ Nothing ->+ FileRecord+ { hash = c.diskHash,+ moduleName = c.moduleName,+ strategy = Template,+ generatedAt = now+ }+ )+ | (c, KeepCurrent) <- conflictResolved+ ]+ skipPaths = [c.path | (c, Skip) <- conflictResolved]+ excludePaths = Set.fromList (Map.keys keepRecords ++ skipPaths)+ opsForExec = filter (not . opTargetsPath excludePaths) opsFiltered++ -- Execute the plan (excluding kept/skipped files)+ runEff $ runFilesystem $ runManifestStore manifestPath $ do+ recs <- executePlan "" opsForExec ownerMap modName now++ -- Build updated manifest with all composed modules+ let orphanedPaths = map (.path) diff.orphaned+ cleanedFiles = foldr Map.delete manifest.files orphanedPaths+ allModuleEntries = updateAllModules manifest.modules modulesInOrder now+ allResolvedVals =+ Map.unions+ [Map.map (.value) vs | vs <- Map.elems resolved]+ appliedRecipe = case recipeInfo of+ Just (rName, rVersion) ->+ Just AppliedRecipe {name = rName, recipeVersion = rVersion, appliedAt = now}+ Nothing -> manifest.recipe+ newManifest =+ Manifest+ { version = currentManifestVersion,+ genAt = now,+ modules = allModuleEntries,+ vars = Map.union (Map.map varValueToText allResolvedVals) manifest.vars,+ files = Map.unions [recs, keepRecords, cleanedFiles],+ recipe = appliedRecipe,+ blueprint = manifest.blueprint+ }++ -- Save manifest+ writeManifest newManifest++ -- Report results+ let nNew = length diff.new+ nMod = length diff.modified+ nUnch = length diff.unchanged+ TIO.putStrLn $+ T.pack (show nNew)+ <> " new, "+ <> T.pack (show nMod)+ <> " modified, "+ <> T.pack (show nUnch)+ <> " unchanged."++ -- Commit generated files if --commit or --commit-message+ when (runOpts.runCommit || isJust runOpts.runCommitMessage) $ do+ let filesToStage =+ map (.path) diff.new+ ++ map (.path) diff.modified+ ++ [manifestPath]+ inGit <- runEff $ runProcessIO $ isGitRepo+ if inGit+ then do+ ignored <- runEff $ runProcessIO $ gitCheckIgnore filesToStage+ let filteredFiles = filter (`notElem` ignored) filesToStage+ if null filteredFiles+ then logIO level (logDebug "--commit: all generated files are git-ignored, skipping commit.")+ else do+ (addExit, _, addErr) <- runEff $ runProcessIO $ gitAdd filteredFiles+ case addExit of+ ExitFailure _ -> logIO level (logWarn $ "git add failed: " <> addErr)+ ExitSuccess -> do+ commitMsg <- case runOpts.runCommitMessage of+ Just msg -> pure msg+ Nothing -> do+ diffText <- runEff $ runProcessIO $ gitDiffCached+ generateCommitMessage modNames diffText+ (commitExit, _, commitErr) <- runEff $ runProcessIO $ gitCommit commitMsg+ case commitExit of+ ExitSuccess -> logIO level (logInfo "Committed generated files to git.")+ ExitFailure _ -> logIO level (logWarn $ "git commit failed: " <> commitErr)+ else+ logIO level (logDebug "--commit: not inside a git repository, skipping.")++ -- Execute commands after file generation+ let commandOps = [(cmd, wd) | RunCommandOp cmd wd <- opsForExec]+ mapM_ (executeCommand level) commandOps++ -- Offer to save prompted values to local config+ let prompted = collectPromptedValues resolved localMap+ when (not (null prompted)) $+ runEff $+ runConfigWriter $+ runConsole $+ offerSavePrompted runOpts.runSavePrompted interactive prompted++-- Helpers++exitError :: LogLevel -> Text -> IO a+exitError level msg = do+ logIO level (logError $ "Error: " <> msg)+ exitFailure++printWarning :: LogLevel -> CompositionWarning -> IO ()+printWarning level (FileOverwritten path overwritten overwriter) =+ logIO level . logWarn $+ "Warning: "+ <> T.pack path+ <> " (from "+ <> overwritten.unModuleName+ <> ") overwritten by "+ <> overwriter.unModuleName+printWarning level (ContentMerged path base contributor) =+ logIO level . logWarn $+ "Merged: "+ <> T.pack path+ <> " (base from "+ <> base.unModuleName+ <> ", patched by "+ <> contributor.unModuleName+ <> ")"++formatDiff :: Bool -> DiffResult -> Map.Map FilePath ModuleName -> Text+formatDiff color diff ownerMap' =+ T.unlines $+ concat+ [ if null diff.new+ then []+ else "New files:" : map (\f -> " " <> colorWrap green "[new]" <> " " <> colorWrap green (T.pack f.path) <> modSuffix f.path) diff.new,+ if null diff.modified+ then []+ else "Modified files:" : map (\f -> " " <> colorWrap yellow "[modified]" <> " " <> colorWrap yellow (T.pack f.path) <> modSuffix f.path) diff.modified,+ if null diff.unchanged+ then []+ else "Unchanged files:" : map (\f -> " " <> colorWrap dim "[unchanged]" <> " " <> colorWrap dim (T.pack f)) diff.unchanged,+ if null diff.conflicts+ then []+ else "Conflicts:" : map (\f -> " " <> colorWrap (bold . red) "[conflict]" <> " " <> colorWrap (bold . red) (T.pack f.path) <> modSuffix f.path) diff.conflicts,+ if null diff.orphaned+ then []+ else "Orphaned files:" : map (\f -> " " <> colorWrap magenta "[orphaned]" <> " " <> colorWrap magenta (T.pack f.path)) diff.orphaned+ ]+ where+ colorWrap fn t = if color then fn t else t+ modSuffix path = case Map.lookup path ownerMap' of+ Just mn -> " " <> colorWrap dim ("(" <> mn.unModuleName <> ")")+ Nothing -> ""++varValueToText :: VarValue -> Text+varValueToText (VText t) = t+varValueToText (VBool True) = "true"+varValueToText (VBool False) = "false"+varValueToText (VInt n) = T.pack (show n)+varValueToText (VList vs) = T.intercalate "," (map varValueToText vs)++-- | Whether an operation is a command (RunCommandOp).+isCommandOp :: Operation -> Bool+isCommandOp (RunCommandOp _ _) = True+isCommandOp _ = False++-- | Check whether an operation targets a file in the given path set.+opTargetsPath :: Set.Set FilePath -> Operation -> Bool+opTargetsPath paths (WriteFileOp dest _ _) = Set.member dest paths+opTargetsPath paths (PatchFileOp dest _ _ _ _) = Set.member dest paths+opTargetsPath _ _ = False++-- | Execute a shell command via @sh -c@, printing output and halting on failure.+executeCommand :: LogLevel -> (Text, Maybe FilePath) -> IO ()+executeCommand level (cmd, workDir) = do+ logIO level (logDebug $ " run " <> cmd)+ (exitCode, cmdOut, cmdErr) <- runEff $ runProcessIO $ runProcess "sh" ["-c", cmd] workDir+ when (not (T.null cmdOut)) $ TIO.putStr cmdOut+ case exitCode of+ ExitSuccess -> pure ()+ ExitFailure code -> do+ when (not (T.null cmdErr)) $ TIO.putStr cmdErr+ logIO level (logError $ "Command failed (exit " <> T.pack (show code) <> "): " <> cmd)+ exitFailure++-- | Apply the pending-migration policy.+--+-- Without @--with-migrations@: the run refuses and prints a one-line+-- summary per pending module.+-- With @--with-migrations@ in dry-run mode: print the same summary+-- and proceed with the diff against the current (pre-migration) disk+-- state.+-- With @--with-migrations@ in apply mode: run @seihou migrate@ for+-- each pending module before computing the run plan, persist the new+-- manifest, and continue.+--+-- Returns the manifest the run flow should continue with.+handlePendingMigrations ::+ LogLevel ->+ RunOpts ->+ FilePath ->+ Manifest ->+ [(ModuleName, MigrationPlan)] ->+ IO Manifest+handlePendingMigrations _ _ _ manifest [] = pure manifest+handlePendingMigrations level runOpts manifestPath manifest pendings+ | not runOpts.runWithMigrations = do+ TIO.putStr (formatRefusalMessage pendings)+ exitFailure+ | runOpts.runDryRun = do+ TIO.putStrLn "Pending migrations detected (--with-migrations + --dry-run):"+ mapM_ (TIO.putStrLn . renderPendingSummary) pendings+ TIO.putStrLn ""+ TIO.putStrLn "Note: the run plan below is computed against the current (pre-migration)"+ TIO.putStrLn "disk state. Re-run without --dry-run to apply migrations and regenerate."+ pure manifest+ | otherwise = do+ logIO level (logInfo "Applying pending migrations before run plan...")+ manifest' <- foldM (applyOneMigration level) manifest pendings+ runEff $+ runFilesystem $+ runManifestStore manifestPath $+ writeManifest manifest'+ pure manifest'++renderPendingSummary :: (ModuleName, MigrationPlan) -> Text+renderPendingSummary (name, plan) =+ " "+ <> name.unModuleName+ <> ": "+ <> renderVersion plan.planFrom+ <> " -> "+ <> renderVersion plan.planTo+ <> " ("+ <> T.pack (show (length plan.planSteps))+ <> " step(s))"++-- | Apply one pending plan in-band. Reuses 'runMigrate' with+-- @migrateNoFetch=True@ since 'detectPendingMigrations' already+-- compared against the locally installed copy: there is no need to+-- clone the source repo a second time. Migration conflicts (a tracked+-- file the user has edited since generation) propagate as a hard+-- failure here; @seihou run --force@ governs the run plan's diff+-- conflicts, not migration conflicts. The fix is to run @seihou+-- migrate <module> --force@ first.+applyOneMigration ::+ LogLevel ->+ Manifest ->+ (ModuleName, MigrationPlan) ->+ IO Manifest+applyOneMigration level manifest (modName, _) =+ case findAppliedByName manifest modName of+ Nothing -> do+ logIO level $+ logError $+ "internal error: applied module '"+ <> modName.unModuleName+ <> "' missing while applying its migration"+ exitFailure+ Just am -> do+ let opts =+ MigrateOpts+ { migrateModule = modName,+ migrateTo = Nothing,+ migrateDryRun = False,+ migrateForce = False,+ migrateJson = False,+ migrateVerbose = False,+ migrateNoFetch = True,+ migrateCommit = False,+ migrateCommitMessage = Nothing+ }+ result <- runMigrate opts manifest am.source+ case result of+ Right (MigrateApplied _ manifest' _ _) -> do+ TIO.putStrLn $ " Migrated " <> modName.unModuleName+ pure manifest'+ Right (MigrateNoOp _) -> pure manifest+ Right (MigrateDryRunOK {}) -> pure manifest+ Left err -> do+ logIO level $+ logError $+ "Migration failed for "+ <> modName.unModuleName+ <> ": "+ <> renderMigrateError err+ exitFailure++renderMigrateError :: MigrateError -> Text+renderMigrateError err = case err of+ MigrateModuleNotApplied n -> "module " <> n.unModuleName <> " not applied"+ MigrateNoRecordedVersion n -> "no version recorded for " <> n.unModuleName+ MigrateInstalledModuleEvalFailed _ msg -> msg+ MigrateInstalledModuleHasNoVersion n _ -> "no version on installed " <> n.unModuleName+ MigrateUnparseableInstalledVersion v -> "bad version " <> v+ MigrateUnparseableTargetVersion v -> "bad target version " <> v+ MigrateUnparseableManifestVersion v -> "bad manifest version " <> v+ MigratePlanFailed _ -> "plan failed"+ MigrateExecFailed _ -> "execution failed; revert your edits or run 'seihou migrate <module> --force' first"+ MigrateNoManifest _ -> "no manifest in current dir"++findAppliedByName :: Manifest -> ModuleName -> Maybe AppliedModule+findAppliedByName manifest name =+ case filter (\am -> am.name == name) manifest.modules of+ (am : _) -> Just am+ [] -> Nothing++-- | Update manifest's applied modules list with all composed modules.+-- | Merge the freshly-composed module instances into the manifest's+-- applied-modules list.+--+-- Each entry keeps its bare 'ModuleName' plus the edge decoration that+-- produced it, so two instances of the same module with different+-- 'ParentVars' coexist in the manifest. Matching against existing+-- entries uses the @(name, parentVars)@ pair, so regenerating only+-- refreshes the matching instance and leaves siblings unchanged.+updateAllModules ::+ [AppliedModule] ->+ [(ModuleInstance, Module, FilePath)] ->+ UTCTime ->+ [AppliedModule]+updateAllModules existing modulesInOrder now =+ let composedKeys =+ Set.fromList+ [ (inst.instanceModule, inst.instanceParentVars)+ | (inst, _, _) <- modulesInOrder+ ]+ filtered = filter (\am -> not (Set.member (am.name, am.parentVars) composedKeys)) existing+ new =+ [ AppliedModule+ { name = inst.instanceModule,+ parentVars = inst.instanceParentVars,+ source = dir,+ moduleVersion = m.version,+ appliedAt = now,+ removal = m.removal+ }+ | (inst, m, dir) <- modulesInOrder+ ]+ in filtered ++ new
+ src-exe/Seihou/CLI/SchemaUpgrade.hs view
@@ -0,0 +1,93 @@+module Seihou.CLI.SchemaUpgrade+ ( handleSchemaUpgrade,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (SchemaUpgradeOpts (..))+import Seihou.CLI.SchemaVersion (schemaHash, schemaUrl)+import Seihou.CLI.Style (dim, green, yellow)+import Seihou.Core.Module (DiscoveredModule (..), defaultSearchPaths, discoverAllModules)+import Seihou.Core.SchemaUpgrade+import Seihou.Prelude+import System.Directory (doesFileExist, getCurrentDirectory)+import System.Exit (exitFailure)++handleSchemaUpgrade :: SchemaUpgradeOpts -> IO ()+handleSchemaUpgrade opts+ | opts.schemaUpgradeAll = do+ searchPaths <- defaultSearchPaths+ modules <- discoverAllModules searchPaths+ let paths = [dir </> "module.dhall" | DiscoveredModule {discoveredDir = dir} <- modules]+ results <- mapM (processModule opts.schemaUpgradeDryRun) paths+ printSummary results+ | otherwise = do+ moduleDir <- case opts.schemaUpgradePath of+ Just p -> pure p+ Nothing -> getCurrentDirectory+ let dhallFile = moduleDir </> "module.dhall"+ exists <- doesFileExist dhallFile+ if not exists+ then do+ TIO.putStrLn $ "Error: " <> T.pack dhallFile <> " not found."+ exitFailure+ else do+ results <- sequence [processModule opts.schemaUpgradeDryRun dhallFile]+ printSummary results++data ProcessResult+ = UpToDate FilePath+ | Fixed FilePath [UpgradeIssue]+ | WouldFix FilePath [UpgradeIssue]+ | ProcessError FilePath Text++processModule :: Bool -> FilePath -> IO ProcessResult+processModule dryRun path = do+ exists <- doesFileExist path+ if not exists+ then pure (ProcessError path "file not found")+ else do+ content <- TIO.readFile path+ case upgradeModuleText schemaUrl schemaHash content of+ AlreadyCurrent -> pure (UpToDate path)+ Upgraded newContent issues+ | dryRun -> do+ printDryRun path issues+ pure (WouldFix path issues)+ | otherwise -> do+ TIO.writeFile path newContent+ printFixed path issues+ pure (Fixed path issues)++printDryRun :: FilePath -> [UpgradeIssue] -> IO ()+printDryRun path issues = do+ TIO.putStrLn $ yellow "[dry run] " <> T.pack path+ mapM_ (\i -> TIO.putStrLn $ " Would fix: " <> issueMessage i) issues++printFixed :: FilePath -> [UpgradeIssue] -> IO ()+printFixed path issues = do+ let count = length issues+ label = if count == 1 then " issue" else " issues"+ TIO.putStrLn $ green " ✓ " <> T.pack path <> " — " <> T.pack (show count) <> label <> " fixed"+ mapM_ (\i -> TIO.putStrLn $ " + " <> issueMessage i) issues++printSummary :: [ProcessResult] -> IO ()+printSummary results = do+ let total = length results+ fixed = length [() | Fixed {} <- results]+ wouldFix = length [() | WouldFix {} <- results]+ upToDate = length [() | UpToDate {} <- results]+ errors = length [() | ProcessError {} <- results]+ TIO.putStrLn ""+ if fixed > 0+ then TIO.putStrLn $ green (T.pack (show fixed) <> " upgraded") <> dim (", " <> T.pack (show upToDate) <> " already current, " <> T.pack (show total) <> " total")+ else+ if wouldFix > 0+ then TIO.putStrLn $ yellow (T.pack (show wouldFix) <> " would be upgraded") <> dim (", " <> T.pack (show upToDate) <> " already current, " <> T.pack (show total) <> " total")+ else TIO.putStrLn $ green "All modules up to date." <> dim (" (" <> T.pack (show total) <> " checked)")+ if errors > 0+ then do+ TIO.putStrLn $ T.pack (show errors) <> " errors:"+ mapM_ (\case ProcessError p msg -> TIO.putStrLn $ " " <> T.pack p <> ": " <> msg; _ -> pure ()) results+ else pure ()
+ src-exe/Seihou/CLI/Setup.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE TemplateHaskell #-}++module Seihou.CLI.Setup+ ( handleSetup,+ )+where++import Data.FileEmbed (embedFile)+import Data.Text.Encoding qualified as TE+import Data.Text.IO qualified as TIO+import Seihou.CLI.AgentCompletion+ ( AgentModelConfig (..),+ AgentProvider (..),+ buildAgentCompletionRequest,+ runAgentCompletion,+ )+import Seihou.CLI.AgentLaunch+ ( AgentContext (..),+ formatAvailableModules,+ formatLocalModules,+ formatManifestState,+ formatModuleDhallState,+ formatSeihouProjectState,+ gatherAgentContext,+ setupAllowedTools,+ substitute,+ )+import Seihou.CLI.AgentLaunchExec (launchConfiguredAgent)+import Seihou.CLI.Commands (SetupOpts (..))+import Seihou.Prelude+import System.Exit (exitFailure, exitWith)++-- | The prompt template, embedded at compile time from data/setup-prompt.md.+promptTemplate :: Text+promptTemplate = TE.decodeUtf8 $(embedFile "data/setup-prompt.md")++handleSetup :: Bool -> AgentModelConfig -> SetupOpts -> IO ()+handleSetup debug modelConfig setupOpts = do+ ctx <- gatherAgentContext+ let systemPrompt = renderPrompt ctx+ runRenderedAgentPrompt debug modelConfig systemPrompt setupOpts.setupPrompt++renderPrompt :: AgentContext -> Text+renderPrompt ctx =+ substitute+ [ ("cwd", ctx.cwd),+ ("seihou_project_state", formatSeihouProjectState ctx),+ ("manifest_state", formatManifestState ctx),+ ("module_dhall_state", formatModuleDhallState ctx),+ ("local_modules", formatLocalModules ctx),+ ("available_modules", formatAvailableModules ctx)+ ]+ promptTemplate++runRenderedAgentPrompt :: Bool -> AgentModelConfig -> Text -> Maybe Text -> IO ()+runRenderedAgentPrompt debug modelConfig systemPrompt initialPrompt+ | debug = TIO.putStr systemPrompt+ | modelConfig.agentProvider == AgentProviderClaudeCli || modelConfig.agentProvider == AgentProviderCodexCli = do+ exitCode <- launchConfiguredAgent modelConfig setupAllowedTools debug systemPrompt initialPrompt+ exitWith exitCode+ | otherwise = do+ result <- runAgentCompletion (buildAgentCompletionRequest modelConfig systemPrompt initialPrompt)+ case result of+ Right assistantText -> TIO.putStrLn assistantText+ Left err -> do+ TIO.putStrLn $ "Error: " <> err+ exitFailure
+ src-exe/Seihou/CLI/Status.hs view
@@ -0,0 +1,68 @@+module Seihou.CLI.Status+ ( handleStatus,+ )+where++import Control.Exception (SomeException, try)+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (StatusOpts (..))+import Seihou.CLI.Outdated (checkInstalledModulesForUpdates)+import Seihou.CLI.PendingMigrations (detectPendingMigrations)+import Seihou.CLI.Shared (logIO)+import Seihou.CLI.StatusRender (formatStatus)+import Seihou.CLI.Style (useColor)+import Seihou.CLI.VersionCompare (OutdatedEntry (..))+import Seihou.Core.Module (defaultSearchPaths, discoverAllModules)+import Seihou.Core.Status (computeTrackedFileStatuses)+import Seihou.Core.Types+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.Logger (logError)+import Seihou.Effect.ManifestStore (readManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Prelude+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)++handleStatus :: StatusOpts -> IO ()+handleStatus opts = do+ let manifestPath = ".seihou" </> "manifest.json"++ -- Run both manifest read and file status computation in the same effect block.+ result <- runEff $ runFilesystem $ runManifestStore manifestPath $ do+ mResult <- readManifest+ case mResult of+ Left err -> pure (Left err)+ Right Nothing -> pure (Right Nothing)+ Right (Just manifest) -> do+ tracked <- computeTrackedFileStatuses manifest+ pure (Right (Just (manifest, tracked)))++ colorEnabled <- useColor++ case result of+ Left err -> do+ logIO LogNormal (logError $ "Error reading manifest: " <> err)+ exitFailure+ Right Nothing ->+ TIO.putStrLn "No Seihou manifest found. Run 'seihou run <module>' to generate a project."+ Right (Just (manifest, tracked)) -> do+ mEntries <-+ if opts.statusCheckUpdates && not (null manifest.modules)+ then fetchUpdateEntries+ else pure Nothing+ pendings <- detectPendingMigrations manifest Nothing+ TIO.putStr (formatStatus colorEnabled manifest tracked mEntries pendings)++-- | Run the update check, catching any IO failure so status still renders.+fetchUpdateEntries :: IO (Maybe [OutdatedEntry])+fetchUpdateEntries = do+ outcome <- try $ do+ searchPaths <- defaultSearchPaths+ modules <- discoverAllModules searchPaths+ checkInstalledModulesForUpdates modules+ case outcome of+ Left (e :: SomeException) -> do+ hPutStrLn stderr $+ "warning: update check failed: " <> show e+ pure Nothing+ Right (entries, _stats) -> pure (Just entries)
+ src-exe/Seihou/CLI/Upgrade.hs view
@@ -0,0 +1,400 @@+module Seihou.CLI.Upgrade+ ( handleUpgrade,+ )+where++import Control.Applicative ((<|>))+import Control.Exception (SomeException, try)+import Control.Monad (when)+import Data.Aeson (ToJSON (..), object, (.=))+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (UpgradeOpts (..))+import Seihou.CLI.Install (installModuleDir)+import Seihou.CLI.InstallShared (OriginInfo (..))+import Seihou.CLI.Migrate+ ( MigrateError (..),+ MigrateOpts (..),+ MigrateResult (..),+ pendingChainFor,+ runMigrate,+ )+import Seihou.CLI.Outdated (moduleNameFromDm, readOriginWithModule)+import Seihou.CLI.RemoteVersion (fetchTrueModuleVersion)+import Seihou.CLI.Style (dim, green, red, useColor, yellow)+import Seihou.CLI.VersionCompare (OutdatedStatus (..), compareVersions)+import Seihou.Core.Install (parseModuleName)+import Seihou.Core.Migration (MigrationPlan (..))+import Seihou.Core.Module (DiscoveredModule (..), ModuleSource (..), defaultSearchPaths, discoverAllModules, validateModule)+import Seihou.Core.Registry (Registry (..), RegistryEntry (..), RepoContents (..), discoverRepoContents)+import Seihou.Core.Types (AppliedModule (..), Manifest (..), Module (..), ModuleName (..))+import Seihou.Core.Version (renderVersion)+import Seihou.Dhall.Eval (evalModuleFromFile, evalRegistryFromFile)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.ManifestStore (readManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Prelude+import System.Exit (ExitCode (..), exitFailure)+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readProcessWithExitCode)++data UpgradeStatus+ = Upgraded+ | AlreadyUpToDate+ | Skipped+ | UpgradeFailed Text+ | SourceUnreachable+ deriving stock (Eq, Show)++data UpgradeEntry = UpgradeEntry+ { moduleName :: Text,+ oldVersion :: Maybe Text,+ newVersion :: Maybe Text,+ upgradeStatus :: UpgradeStatus+ }+ deriving stock (Eq, Show)++instance ToJSON UpgradeEntry where+ toJSON e =+ object+ [ "module" .= e.moduleName,+ "oldVersion" .= e.oldVersion,+ "newVersion" .= e.newVersion,+ "status" .= statusText e.upgradeStatus+ ]+ where+ statusText :: UpgradeStatus -> Text+ statusText Upgraded = "upgraded"+ statusText AlreadyUpToDate = "up to date"+ statusText Skipped = "skipped"+ statusText (UpgradeFailed reason) = "failed: " <> reason+ statusText SourceUnreachable = "unreachable"++handleUpgrade :: UpgradeOpts -> IO ()+handleUpgrade uopts = do+ searchPaths <- defaultSearchPaths+ modules <- discoverAllModules searchPaths+ let installed = filter (\dm -> dm.discoveredSource == SourceInstalled) modules++ if null installed+ then TIO.putStrLn "No installed modules found."+ else do+ originsWithModules <- mapM readOriginWithModule installed+ let withOrigins = [(dm, origin) | (dm, Just origin) <- originsWithModules]++ filtered <- case uopts.upgradeModules of+ [] -> pure withOrigins+ names -> do+ let result = [(dm, origin) | (dm, origin) <- withOrigins, moduleNameFromDm dm `elem` names]+ found = map (moduleNameFromDm . fst) result+ missing = filter (`notElem` found) names+ when (not (null missing)) $ do+ TIO.putStrLn $ "Module(s) not found: " <> T.intercalate ", " missing+ exitFailure+ pure result++ if null filtered+ then TIO.putStrLn "No installed modules with origin metadata found."+ else do+ let grouped = Map.toList $ Map.fromListWith (++) [(origin.sourceUrl, [(dm, origin)]) | (dm, origin) <- filtered]++ if uopts.upgradeDryRun+ then TIO.putStrLn "Checking installed modules for updates (dry run)..."+ else TIO.putStrLn "Upgrading installed modules..."++ entries <- concat <$> mapM (upgradeSource uopts) grouped++ if uopts.upgradeJson+ then LBS.putStr (encodePretty entries)+ else renderUpgradeTable entries++ -- After all upgrades, see whether the *current project* has+ -- migrations pending for any module that was upgraded just+ -- now. Either run them (--with-migrations) or print a+ -- one-line advisory per module.+ unless uopts.upgradeDryRun $+ handlePostUpgradeMigrations uopts entries++upgradeSource :: UpgradeOpts -> (Text, [(DiscoveredModule, OriginInfo)]) -> IO [UpgradeEntry]+upgradeSource uopts (sourceUrl, modulesWithOrigins) = do+ let repoName = parseModuleName sourceUrl+ TIO.putStrLn $ " Cloning " <> T.pack repoName <> "..."++ result <- try $ withSystemTempDirectory "seihou-upgrade" $ \tmpDir -> do+ let cloneDir = tmpDir </> repoName+ (exitCode, _stdout, _stderr) <- readProcessWithExitCode "git" ["clone", "--depth", "1", T.unpack sourceUrl, cloneDir] ""+ case exitCode of+ ExitFailure _ -> pure Nothing+ ExitSuccess -> do+ contents <- discoverRepoContents evalRegistryFromFile cloneDir+ Just <$> mapM (upgradeModule uopts cloneDir contents sourceUrl) modulesWithOrigins++ case result of+ Left (_ :: SomeException) ->+ pure [mkUnreachableEntry dm origin | (dm, origin) <- modulesWithOrigins]+ Right Nothing ->+ pure [mkUnreachableEntry dm origin | (dm, origin) <- modulesWithOrigins]+ Right (Just entries) ->+ pure entries++mkUnreachableEntry :: DiscoveredModule -> OriginInfo -> UpgradeEntry+mkUnreachableEntry dm origin =+ UpgradeEntry+ { moduleName = moduleNameFromDm dm,+ oldVersion = origin.version,+ newVersion = Nothing,+ upgradeStatus = SourceUnreachable+ }++upgradeModule :: UpgradeOpts -> FilePath -> RepoContents -> Text -> (DiscoveredModule, OriginInfo) -> IO UpgradeEntry+upgradeModule uopts cloneDir contents sourceUrl (dm, origin) = do+ let name = moduleNameFromDm dm+ installedVer = origin.version+ availableVer <- fetchAvailable cloneDir (ModuleName name)+ let status = compareVersions installedVer availableVer++ case status of+ OutdatedSt+ | uopts.upgradeDryRun ->+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = availableVer, upgradeStatus = Upgraded}+ | otherwise ->+ doUpgrade cloneDir contents sourceUrl origin name installedVer availableVer+ UpToDate ->+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = availableVer, upgradeStatus = AlreadyUpToDate}+ Unversioned+ | uopts.upgradeSkipUnversioned ->+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = availableVer, upgradeStatus = Skipped}+ | uopts.upgradeDryRun ->+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = availableVer, upgradeStatus = Upgraded}+ | otherwise ->+ doUpgrade cloneDir contents sourceUrl origin name installedVer availableVer+ Unreachable ->+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = Nothing, upgradeStatus = SourceUnreachable}++doUpgrade :: FilePath -> RepoContents -> Text -> OriginInfo -> Text -> Maybe Text -> Maybe Text -> IO UpgradeEntry+doUpgrade cloneDir contents sourceUrl origin name installedVer availableVer = do+ let result = case contents of+ SingleModule rootDir -> Just (rootDir, origin.repoName)+ MultiModule registry ->+ case filter (\e -> e.name.unModuleName == name) registry.modules of+ (entry : _) -> Just (cloneDir </> entry.path, Just registry.repoName)+ [] -> Nothing+ SingleRecipe _ -> Nothing+ SingleBlueprint _ -> Nothing+ SinglePrompt _ -> Nothing+ EmptyRepo -> Nothing++ case result of+ Nothing ->+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = availableVer, upgradeStatus = UpgradeFailed "module not found in remote"}+ Just (moduleDir, registryName) -> do+ let dhallFile = moduleDir </> "module.dhall"+ decoded <- evalModuleFromFile dhallFile+ case decoded of+ Left err ->+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = availableVer, upgradeStatus = UpgradeFailed (T.pack (show err))}+ Right modul -> do+ valResult <- validateModule moduleDir modul+ case valResult of+ Left err ->+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = availableVer, upgradeStatus = UpgradeFailed (T.pack (show err))}+ Right _ -> do+ -- Trust the module.dhall version over the registry's static+ -- entry.version: the registry can be stale (the bug fixed in+ -- docs/plans/14-fix-outdated-version-detection.md). Tags are+ -- still sourced from the registry entry since module.dhall+ -- has no equivalent field.+ let (ver, entryTags) = case contents of+ MultiModule registry -> case filter (\e -> e.name.unModuleName == name) registry.modules of+ (entry : _) -> (modul.version <|> entry.version, entry.tags)+ [] -> (modul.version, [])+ _ -> (modul.version, [])+ installModuleDir moduleDir (T.unpack name) sourceUrl registryName ver entryTags+ TIO.putStrLn $ " Upgraded " <> name+ pure UpgradeEntry {moduleName = name, oldVersion = installedVer, newVersion = availableVer, upgradeStatus = Upgraded}++renderUpgradeTable :: [UpgradeEntry] -> IO ()+renderUpgradeTable entries = do+ colorEnabled <- useColor+ let maxNameLen = max 6 (maximum (map (T.length . (.moduleName)) entries))+ maxOldLen = max 3 (maximum (map (T.length . maybe "(none)" id . (.oldVersion)) entries))+ maxNewLen = max 3 (maximum (map (T.length . maybe "(none)" id . (.newVersion)) entries))++ padR n t = t <> T.replicate (n - T.length t + 2) " "++ header =+ padR maxNameLen "Module"+ <> padR maxOldLen "Old"+ <> padR maxNewLen "New"+ <> "Status"++ formatRow e =+ let oldText = maybe "(none)" id e.oldVersion+ newText = maybe "(none)" id e.newVersion+ statusTxt = case e.upgradeStatus of+ Upgraded -> if colorEnabled then green "upgraded" else "upgraded"+ AlreadyUpToDate -> if colorEnabled then dim "up to date" else "up to date"+ Skipped -> if colorEnabled then yellow "skipped (unversioned)" else "skipped (unversioned)"+ UpgradeFailed reason -> if colorEnabled then red ("failed: " <> reason) else "failed: " <> reason+ SourceUnreachable -> if colorEnabled then yellow "unreachable" else "unreachable"+ in padR maxNameLen e.moduleName+ <> padR maxOldLen oldText+ <> padR maxNewLen newText+ <> statusTxt++ TIO.putStrLn ""+ TIO.putStrLn header+ mapM_ (TIO.putStrLn . formatRow) entries++ let upgraded = length (filter (\e -> e.upgradeStatus == Upgraded) entries)+ failed = length (filter isFailedEntry entries)+ skipped = length (filter (\e -> e.upgradeStatus == Skipped) entries)+ TIO.putStrLn ""+ TIO.putStrLn $+ T.pack (show (length entries))+ <> " module(s) checked, "+ <> T.pack (show upgraded)+ <> " upgraded"+ <> (if failed > 0 then ", " <> T.pack (show failed) <> " failed" else "")+ <> (if skipped > 0 then ", " <> T.pack (show skipped) <> " skipped" else "")+ <> "."++isFailedEntry :: UpgradeEntry -> Bool+isFailedEntry e = case e.upgradeStatus of+ UpgradeFailed _ -> True+ SourceUnreachable -> True+ _ -> False++-- | After the upgrade table is printed, look at the project's local+-- manifest for each module that was just upgraded. If the upgrade+-- raised the installed-copy version above the manifest's recorded+-- version, there are migrations to run. With @--with-migrations@,+-- run them. Otherwise, print a single advisory line per module.+--+-- If there's no local manifest at all (the user is upgrading without+-- a project), this is a silent no-op.+handlePostUpgradeMigrations :: UpgradeOpts -> [UpgradeEntry] -> IO ()+handlePostUpgradeMigrations uopts entries = do+ let manifestPath = ".seihou" </> "manifest.json"+ upgraded =+ [ entry.moduleName | entry <- entries, entry.upgradeStatus == Upgraded+ ]+ if null upgraded+ then pure ()+ else do+ mfRes <- runEff $ runFilesystem $ runManifestStore manifestPath readManifest+ case mfRes of+ Left _ -> pure ()+ Right Nothing -> pure ()+ Right (Just manifest) ->+ mapM_ (handleOneModule uopts manifest) upgraded++handleOneModule :: UpgradeOpts -> Manifest -> Text -> IO ()+handleOneModule uopts manifest name =+ case findAppliedByName manifest name of+ Nothing -> pure ()+ Just am -> do+ let dhallFile = am.source </> "module.dhall"+ r <- evalModuleFromFile dhallFile+ case r of+ Left _ -> pure ()+ Right installed ->+ case pendingChainFor am installed of+ Nothing -> pure ()+ Just plan+ | uopts.upgradeWithMigrations -> runOnePostUpgradeMigration am.source name+ | otherwise -> printAdvisory name plan++findAppliedByName :: Manifest -> Text -> Maybe AppliedModule+findAppliedByName manifest name =+ case filter (\am -> am.name.unModuleName == name) manifest.modules of+ (am : _) -> Just am+ [] -> Nothing++printAdvisory :: Text -> MigrationPlan -> IO ()+printAdvisory name plan = do+ colorEnabled <- useColor+ let msg =+ "note: "+ <> name+ <> " has "+ <> T.pack (show (length plan.planSteps))+ <> " migration(s) pending ("+ <> renderVersion plan.planFrom+ <> " → "+ <> renderVersion plan.planTo+ <> "); run 'seihou migrate "+ <> name+ <> "'"+ TIO.putStrLn $ if colorEnabled then yellow msg else msg++-- | Run a migration for a single module. Reads the manifest fresh so+-- chained migrations against multiple upgraded modules see each+-- other's effects.+runOnePostUpgradeMigration :: FilePath -> Text -> IO ()+runOnePostUpgradeMigration installedDir name = do+ let manifestPath = ".seihou" </> "manifest.json"+ mfRes <- runEff $ runFilesystem $ runManifestStore manifestPath readManifest+ case mfRes of+ Right (Just manifest) -> do+ let opts =+ MigrateOpts+ { migrateModule = ModuleName name,+ migrateTo = Nothing,+ migrateDryRun = False,+ migrateForce = False,+ migrateJson = False,+ migrateVerbose = False,+ -- The post-upgrade hook has already refreshed the+ -- installed copy via 'seihou upgrade'; skip the+ -- redundant fetch in 'runMigrate'.+ migrateNoFetch = True,+ migrateCommit = False,+ migrateCommitMessage = Nothing+ }+ result <- runMigrate opts manifest installedDir+ case result of+ Right (MigrateApplied _ _ _ _) -> do+ colorEnabled <- useColor+ let msg = " Migrated " <> name+ TIO.putStrLn $ if colorEnabled then green msg else msg+ Right (MigrateNoOp _) -> pure ()+ Right (MigrateDryRunOK {}) -> pure ()+ Left err -> do+ colorEnabled <- useColor+ let msg = " Migration failed for " <> name <> ": " <> renderMigrateError err+ TIO.putStrLn $ if colorEnabled then red msg else msg+ _ -> pure ()++renderMigrateError :: MigrateError -> Text+renderMigrateError err = case err of+ MigrateModuleNotApplied n -> "module " <> n.unModuleName <> " not applied"+ MigrateNoRecordedVersion n -> "no version recorded for " <> n.unModuleName+ MigrateInstalledModuleEvalFailed _ msg -> msg+ MigrateInstalledModuleHasNoVersion n _ -> "no version on installed " <> n.unModuleName+ MigrateUnparseableInstalledVersion v -> "bad version " <> v+ MigrateUnparseableTargetVersion v -> "bad target version " <> v+ MigrateUnparseableManifestVersion v -> "bad manifest version " <> v+ MigratePlanFailed _ -> "plan failed"+ MigrateExecFailed _ -> "execution failed (use --force or revert your edits)"+ MigrateNoManifest _ -> "no manifest in current dir"++-- | Local @unless@ to avoid pulling in another import.+unless :: Bool -> IO () -> IO ()+unless True _ = pure ()+unless False action = action++-- | Look up the available version of a module in a cloned repo by reading+-- its @module.dhall@. Fetch errors collapse to @Nothing@; downstream+-- 'compareVersions' treats that as "unversioned" and 'doUpgrade' will+-- still attempt the install (the registry's static @version@ is no longer+-- consulted for the comparison — see EP-1).+fetchAvailable :: FilePath -> ModuleName -> IO (Maybe Text)+fetchAvailable cloneDir name = do+ result <- fetchTrueModuleVersion cloneDir name+ case result of+ Right v -> pure v+ Left _ -> pure Nothing
+ src-exe/Seihou/CLI/Validate.hs view
@@ -0,0 +1,73 @@+module Seihou.CLI.Validate+ ( handleValidateModule,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (ValidateOpts (..))+import Seihou.CLI.Shared (logIO)+import Seihou.CLI.Style (renderReportColor, useColor)+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalModuleFromFile)+import Seihou.Effect.Logger (logError)+import Seihou.Engine.Validate (ValidateReport (..), buildReport, reportHasErrors)+import Seihou.Prelude+import System.Directory (doesFileExist, getCurrentDirectory)+import System.Exit (ExitCode (..), exitFailure, exitWith)++handleValidateModule :: ValidateOpts -> IO ()+handleValidateModule vopts = do+ -- Determine module path+ moduleDir <- case vopts.validatePath of+ Just p -> pure p+ Nothing -> getCurrentDirectory++ let dhallFile = moduleDir </> "module.dhall"++ -- Check that module.dhall exists+ exists <- doesFileExist dhallFile+ if not exists+ then do+ logIO LogNormal (logError $ T.pack dhallFile <> " not found.")+ exitWith (ExitFailure 4)+ else pure ()++ -- Evaluate Dhall+ decoded <- evalModuleFromFile dhallFile+ colorEnabled <- useColor++ case decoded of+ Left err -> do+ -- Dhall failed: build a report with reportDhallOk = False+ let dummyModule =+ Module+ { name = ModuleName "<unknown>",+ version = Nothing,+ description = Nothing,+ vars = [],+ exports = [],+ prompts = [],+ steps = [],+ commands = [],+ dependencies = [],+ removal = Nothing,+ migrations = []+ }+ report =+ ValidateReport+ { reportModule = dummyModule,+ reportPath = moduleDir,+ reportDhallOk = False,+ reportDhallError = Just (T.pack (show err)),+ reportChecks = []+ }+ TIO.putStr (renderReportColor colorEnabled report)+ exitFailure+ Right modul -> do+ -- Build the structured report+ report <- buildReport vopts.validateLint moduleDir modul+ TIO.putStr (renderReportColor colorEnabled report)+ if reportHasErrors report+ then exitFailure+ else pure ()
+ src-exe/Seihou/CLI/ValidateBlueprint.hs view
@@ -0,0 +1,187 @@+module Seihou.CLI.ValidateBlueprint+ ( handleValidateBlueprint,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (ValidateBlueprintOpts (..))+import Seihou.CLI.Shared (logIO)+import Seihou.CLI.Style (bold, cyan, dim, green, red, useColor, yellow)+import Seihou.Core.Blueprint+ ( checkBlueprintAllowedTools,+ checkBlueprintBaseModules,+ checkBlueprintFiles,+ checkBlueprintNameFormat,+ checkBlueprintPromptNonEmpty,+ checkBlueprintPromptRefs,+ checkBlueprintTags,+ checkBlueprintUniqueVars,+ checkBlueprintVersionPresent,+ )+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalBlueprintFromFile)+import Seihou.Effect.Logger (logError)+import Seihou.Engine.Validate (DiagCheck (..), DiagSeverity (..))+import Seihou.Prelude+import System.Directory (doesFileExist, getCurrentDirectory)+import System.Exit (ExitCode (..), exitFailure, exitWith)++-- | A complete validation report for a blueprint. Mirrors+-- 'Seihou.Engine.Validate.ValidateReport' but is keyed on a 'Blueprint'+-- rather than a 'Module', and reports on the rules that apply to+-- blueprints (no steps, no exports, no commands, but a non-empty prompt+-- and a 'files/' integrity check).+data BlueprintReport = BlueprintReport+ { -- | 'Nothing' when Dhall evaluation failed; otherwise the decoded record+ brBlueprint :: Maybe Blueprint,+ -- | Display name; equals the decoded blueprint's name when available+ brName :: Text,+ brPath :: FilePath,+ brDhallOk :: Bool,+ brDhallError :: Maybe Text,+ brChecks :: [DiagCheck]+ }++handleValidateBlueprint :: ValidateBlueprintOpts -> IO ()+handleValidateBlueprint vopts = do+ blueprintDir <- case vopts.validateBlueprintPath of+ Just p -> pure p+ Nothing -> getCurrentDirectory++ let dhallFile = blueprintDir </> "blueprint.dhall"++ exists <- doesFileExist dhallFile+ if not exists+ then do+ logIO LogNormal (logError $ T.pack dhallFile <> " not found.")+ exitWith (ExitFailure 4)+ else pure ()++ decoded <- evalBlueprintFromFile dhallFile+ colorEnabled <- useColor++ case decoded of+ Left err -> do+ let report =+ BlueprintReport+ { brBlueprint = Nothing,+ brName = "<unknown>",+ brPath = blueprintDir,+ brDhallOk = False,+ brDhallError = Just (T.pack (show err)),+ brChecks = []+ }+ TIO.putStr (renderBlueprintReport colorEnabled report)+ exitFailure+ Right bp -> do+ report <- buildBlueprintReport blueprintDir bp+ TIO.putStr (renderBlueprintReport colorEnabled report)+ if blueprintReportHasErrors report+ then exitFailure+ else pure ()++-- | Build a structured validation report for a decoded blueprint by+-- running each of EP-29's pure and IO check functions and labelling the+-- result. Lint warnings are not yet implemented — the @--lint@ flag is+-- accepted for parity with @validate-module@ but currently has no+-- effect; future work can extend this list.+buildBlueprintReport :: FilePath -> Blueprint -> IO BlueprintReport+buildBlueprintReport baseDir b = do+ fileErrors <- checkBlueprintFiles baseDir b+ baseErrors <- checkBlueprintBaseModules b+ let checks =+ [ DiagCheck "Blueprint name format" DiagError (checkBlueprintNameFormat b),+ DiagCheck "Blueprint version" DiagError (checkBlueprintVersionPresent b),+ DiagCheck "Prompt body non-empty" DiagError (checkBlueprintPromptNonEmpty b),+ DiagCheck "Unique variable names" DiagError (checkBlueprintUniqueVars b),+ DiagCheck "Prompt references" DiagError (checkBlueprintPromptRefs b),+ DiagCheck "Base modules" DiagError baseErrors,+ DiagCheck "Reference file existence" DiagError fileErrors,+ DiagCheck "Tags" DiagError (checkBlueprintTags b),+ DiagCheck "Allowed tools" DiagError (checkBlueprintAllowedTools b)+ ]+ pure+ BlueprintReport+ { brBlueprint = Just b,+ brName = b.name.unModuleName,+ brPath = baseDir,+ brDhallOk = True,+ brDhallError = Nothing,+ brChecks = checks+ }++blueprintReportHasErrors :: BlueprintReport -> Bool+blueprintReportHasErrors r =+ not r.brDhallOk+ || any (\c -> c.diagSeverity == DiagError && not (null c.diagDetails)) r.brChecks++renderBlueprintReport :: Bool -> BlueprintReport -> Text+renderBlueprintReport color report =+ T.unlines $+ [ "Validating blueprint at " <> T.pack report.brPath <> "...",+ ""+ ]+ ++ dhallLine+ ++ summaryLines+ ++ checkLines+ ++ [""]+ ++ [resultLine]+ where+ okMark = if color then green "\x2713" else "\x2713"+ errMark = if color then bold (red "\x2717") else "\x2717"+ warnMark = if color then yellow "\x26A0" else "\x26A0"+ nameStyle t = if color then cyan t else t+ detailStyle t = if color then dim t else t+ labelErr t = if color then red t else t+ labelWarn t = if color then yellow t else t++ dhallLine =+ if report.brDhallOk+ then [" " <> okMark <> " blueprint.dhall evaluates successfully"]+ else+ [" " <> errMark <> " blueprint.dhall failed to evaluate"]+ ++ case report.brDhallError of+ Just errText -> [" " <> detailStyle errText]+ Nothing -> []++ summaryLines = case report.brBlueprint of+ Nothing -> []+ Just b ->+ [ " " <> okMark <> " Blueprint name: " <> nameStyle b.name.unModuleName,+ " " <> okMark <> " " <> T.pack (show (length b.vars)) <> " variables declared",+ " " <> okMark <> " " <> T.pack (show (length b.prompts)) <> " prompts defined",+ " " <> okMark <> " " <> T.pack (show (length b.baseModules)) <> " base modules declared",+ " " <> okMark <> " " <> T.pack (show (length b.files)) <> " reference files declared"+ ]++ checkLines = concatMap renderCheck report.brChecks++ renderCheck c+ | null c.diagDetails =+ [" " <> okMark <> " " <> c.diagLabel]+ | c.diagSeverity == DiagWarning =+ (" " <> warnMark <> " " <> labelWarn c.diagLabel)+ : map (\d -> " " <> detailStyle d) c.diagDetails+ | otherwise =+ (" " <> errMark <> " " <> labelErr c.diagLabel)+ : map (\d -> " " <> detailStyle d) c.diagDetails++ errorCount =+ length+ [ ()+ | c <- report.brChecks,+ c.diagSeverity == DiagError,+ not (null c.diagDetails)+ ]++ dhallFailed = not report.brDhallOk+ totalErrors = errorCount + (if dhallFailed then 1 else 0)++ resultLine+ | totalErrors > 0 =+ let msg = T.pack (show totalErrors) <> " error(s) found."+ in (if color then bold (red msg) else msg) <> " Blueprint is invalid."+ | otherwise =+ let msg = "Blueprint '" <> report.brName <> "' is valid."+ in if color then green msg else msg
+ src-exe/Seihou/CLI/ValidatePrompt.hs view
@@ -0,0 +1,177 @@+module Seihou.CLI.ValidatePrompt+ ( handleValidatePrompt,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (ValidatePromptOpts (..))+import Seihou.CLI.Shared (logIO)+import Seihou.CLI.Style (bold, cyan, dim, green, red, useColor, yellow)+import Seihou.Core.AgentPrompt+ ( checkAgentPromptAllowedTools,+ checkAgentPromptBodyNonEmpty,+ checkAgentPromptCommandVars,+ checkAgentPromptFiles,+ checkAgentPromptGuidance,+ checkAgentPromptNameFormat,+ checkAgentPromptPromptRefs,+ checkAgentPromptTags,+ checkAgentPromptUniqueVars,+ checkAgentPromptVersionPresent,+ )+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalAgentPromptFromFile)+import Seihou.Effect.Logger (logError)+import Seihou.Engine.Validate (DiagCheck (..), DiagSeverity (..))+import Seihou.Prelude+import System.Directory (doesFileExist, getCurrentDirectory)+import System.Exit (ExitCode (..), exitFailure, exitWith)++data PromptReport = PromptReport+ { prPrompt :: Maybe AgentPrompt,+ prName :: Text,+ prPath :: FilePath,+ prDhallOk :: Bool,+ prDhallError :: Maybe Text,+ prChecks :: [DiagCheck]+ }++handleValidatePrompt :: ValidatePromptOpts -> IO ()+handleValidatePrompt vopts = do+ promptDir <- case vopts.validatePromptPath of+ Just p -> pure p+ Nothing -> getCurrentDirectory++ let dhallFile = promptDir </> "prompt.dhall"++ exists <- doesFileExist dhallFile+ if not exists+ then do+ logIO LogNormal (logError $ T.pack dhallFile <> " not found.")+ exitWith (ExitFailure 4)+ else pure ()++ decoded <- evalAgentPromptFromFile dhallFile+ colorEnabled <- useColor++ case decoded of+ Left err -> do+ let report =+ PromptReport+ { prPrompt = Nothing,+ prName = "<unknown>",+ prPath = promptDir,+ prDhallOk = False,+ prDhallError = Just (T.pack (show err)),+ prChecks = []+ }+ TIO.putStr (renderPromptReport colorEnabled report)+ exitFailure+ Right p -> do+ report <- buildPromptReport promptDir p+ TIO.putStr (renderPromptReport colorEnabled report)+ if promptReportHasErrors report+ then exitFailure+ else pure ()++buildPromptReport :: FilePath -> AgentPrompt -> IO PromptReport+buildPromptReport baseDir p = do+ fileErrors <- checkAgentPromptFiles baseDir p+ let checks =+ [ DiagCheck "Prompt name format" DiagError (checkAgentPromptNameFormat p),+ DiagCheck "Prompt version" DiagError (checkAgentPromptVersionPresent p),+ DiagCheck "Prompt body non-empty" DiagError (checkAgentPromptBodyNonEmpty p),+ DiagCheck "Unique variable names" DiagError (checkAgentPromptUniqueVars p),+ DiagCheck "Prompt references" DiagError (checkAgentPromptPromptRefs p),+ DiagCheck "Command variables" DiagError (checkAgentPromptCommandVars p),+ DiagCheck "Prompt guidance" DiagError (checkAgentPromptGuidance p),+ DiagCheck "Reference file existence" DiagError fileErrors,+ DiagCheck "Tags" DiagError (checkAgentPromptTags p),+ DiagCheck "Allowed tools" DiagError (checkAgentPromptAllowedTools p)+ ]+ pure+ PromptReport+ { prPrompt = Just p,+ prName = p.name.unModuleName,+ prPath = baseDir,+ prDhallOk = True,+ prDhallError = Nothing,+ prChecks = checks+ }++promptReportHasErrors :: PromptReport -> Bool+promptReportHasErrors r =+ not r.prDhallOk+ || any (\c -> c.diagSeverity == DiagError && not (null c.diagDetails)) r.prChecks++renderPromptReport :: Bool -> PromptReport -> Text+renderPromptReport color report =+ T.unlines $+ [ "Validating prompt at " <> T.pack report.prPath <> "...",+ ""+ ]+ ++ dhallLine+ ++ summaryLines+ ++ checkLines+ ++ [""]+ ++ [resultLine]+ where+ okMark = if color then green "\x2713" else "\x2713"+ errMark = if color then bold (red "\x2717") else "\x2717"+ warnMark = if color then yellow "\x26A0" else "\x26A0"+ nameStyle t = if color then cyan t else t+ detailStyle t = if color then dim t else t+ labelErr t = if color then red t else t+ labelWarn t = if color then yellow t else t++ dhallLine =+ if report.prDhallOk+ then [" " <> okMark <> " prompt.dhall evaluates successfully"]+ else+ [" " <> errMark <> " prompt.dhall failed to evaluate"]+ ++ case report.prDhallError of+ Just errText -> [" " <> detailStyle errText]+ Nothing -> []++ summaryLines = case report.prPrompt of+ Nothing -> []+ Just p ->+ [ " " <> okMark <> " Prompt name: " <> nameStyle p.name.unModuleName,+ " " <> okMark <> " " <> T.pack (show (length p.vars)) <> " variables declared",+ " " <> okMark <> " " <> T.pack (show (length p.prompts)) <> " prompts defined",+ " " <> okMark <> " " <> T.pack (show (length p.commandVars)) <> " command variables declared",+ " " <> okMark <> " " <> T.pack (show (length p.guidance)) <> " guidance blocks declared",+ " " <> okMark <> " " <> T.pack (show (length p.files)) <> " reference files declared"+ ]++ checkLines = concatMap renderCheck report.prChecks++ renderCheck c+ | null c.diagDetails =+ [" " <> okMark <> " " <> c.diagLabel]+ | c.diagSeverity == DiagWarning =+ (" " <> warnMark <> " " <> labelWarn c.diagLabel)+ : map (\d -> " " <> detailStyle d) c.diagDetails+ | otherwise =+ (" " <> errMark <> " " <> labelErr c.diagLabel)+ : map (\d -> " " <> detailStyle d) c.diagDetails++ errorCount =+ length+ [ ()+ | c <- report.prChecks,+ c.diagSeverity == DiagError,+ not (null c.diagDetails)+ ]++ dhallFailed = not report.prDhallOk+ totalErrors = errorCount + (if dhallFailed then 1 else 0)++ resultLine+ | totalErrors > 0 =+ let msg = T.pack (show totalErrors) <> " error(s) found."+ in (if color then bold (red msg) else msg) <> " Prompt is invalid."+ | otherwise =+ let msg = "Prompt '" <> report.prName <> "' is valid."+ in if color then green msg else msg
+ src-exe/Seihou/CLI/Vars.hs view
@@ -0,0 +1,210 @@+module Seihou.CLI.Vars+ ( handleVars,+ )+where++import Control.Monad (when)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (VarsOpts (..))+import Seihou.CLI.Shared (deriveNamespace, formatVarError, logIO, toVarNameMap, unwrapConfig)+import Seihou.Composition.Instance (ModuleInstance (..))+import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts)+import Seihou.Core.Context (resolveContext)+import Seihou.Core.Module (defaultSearchPaths, discoverRunnable)+import Seihou.Core.Types+import Seihou.Core.Variable (diagnoseResolution, formatDeclarations, formatExplain)+import Seihou.Effect.ConfigReader (readContextConfig, readGlobalConfig, readLocalConfig, readNamespaceConfig)+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Effect.ConsoleInterp (runConsole)+import Seihou.Effect.FzfInterp (runFzfIO)+import Seihou.Effect.Logger (logError, logInfo)+import Seihou.Fzf (FzfResult (..), detectFzfConfig, isFzfUsable)+import Seihou.Fzf.Selector (selectModule)+import Seihou.Prelude+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..), exitFailure, exitWith)++handleVars :: VarsOpts -> IO ()+handleVars vopts = do+ -- Resolve module name (from argument or fzf picker)+ modName <- case vopts.varsModule of+ Just name -> pure name+ Nothing -> do+ fzfCfg <- detectFzfConfig+ if isFzfUsable fzfCfg+ then do+ result <- runEff $ runFzfIO fzfCfg $ selectModule+ case result of+ FzfSelected name -> pure name+ FzfCancelled -> exitWith ExitSuccess+ FzfNoMatch -> do+ logIO LogNormal (logError "No modules found.")+ exitFailure+ FzfError err -> do+ logIO LogNormal (logError $ "fzf error: " <> err)+ exitFailure+ else do+ logIO LogNormal (logError "MODULE argument is required when fzf is not available.")+ exitFailure++ -- Resolve the runnable's kind first so we can dispatch correctly:+ -- modules go through the existing module/composition pipeline,+ -- recipes show their declared vars in declaration mode, and+ -- blueprints get their own declaration-mode formatter and refuse+ -- @--explain@ entirely (resolving a blueprint's variables is the+ -- agent runner's job, not vars').+ searchPaths <- defaultSearchPaths+ discResult <- discoverRunnable searchPaths modName+ case discResult of+ Left (ModuleNotFound _ searched) -> do+ logIO LogNormal $ do+ logError $ "Module '" <> modName.unModuleName <> "' not found."+ logError "Searched in:"+ mapM_ (\p -> logError $ " " <> T.pack p) searched+ exitFailure+ Left err -> do+ logIO LogNormal (logError $ T.pack (show err))+ exitFailure+ Right (RunnableModule m _) ->+ if vopts.varsExplain+ then explainMode modName vopts+ else declarationModeModule m+ Right (RunnableRecipe r _) ->+ if vopts.varsExplain+ then explainMode modName vopts+ else declarationModeRecipe r+ Right (RunnableBlueprint b _) ->+ if vopts.varsExplain+ then do+ logIO LogNormal $ do+ logError $ "'" <> modName.unModuleName <> "' is a blueprint; --explain is not supported in this release."+ logError "Resolving a blueprint's variables requires the agent runner."+ logError "Run `seihou agent run <blueprint>` instead (when EP-31 ships)."+ logError "For a read-only listing of declared variables, omit --explain."+ exitFailure+ else declarationModeBlueprint b++-- | Declaration mode for a module: list declared variables.+declarationModeModule :: Module -> IO ()+declarationModeModule modul = do+ let vs = modul.vars+ if null vs+ then TIO.putStrLn "No variables declared."+ else do+ TIO.putStrLn $ "Variables for " <> modul.name.unModuleName <> ":"+ TIO.putStrLn ""+ TIO.putStr (formatDeclarations vs)++-- | Declaration mode for a recipe: list its declared variables. Recipes+-- carry their own @vars@ list (separately from the modules they+-- compose); this prints those without expanding the recipe.+declarationModeRecipe :: Recipe -> IO ()+declarationModeRecipe r = do+ let vs = r.vars+ if null vs+ then TIO.putStrLn "No variables declared."+ else do+ TIO.putStrLn $ "Variables for " <> r.name.unRecipeName <> " (recipe):"+ TIO.putStrLn ""+ TIO.putStr (formatDeclarations vs)++-- | Declaration mode for a blueprint: list its declared variables. The+-- blueprint kind is surfaced in the heading so users can tell at a+-- glance that this is the agent-driven runnable, not a module/recipe.+declarationModeBlueprint :: Blueprint -> IO ()+declarationModeBlueprint b = do+ let vs = b.vars+ if null vs+ then TIO.putStrLn "No variables declared."+ else do+ TIO.putStrLn $ "Variables for " <> b.name.unModuleName <> " (blueprint):"+ TIO.putStrLn ""+ TIO.putStr (formatDeclarations vs)++-- | Explain mode: load full composition, resolve variables with exports, show provenance+explainMode :: ModuleName -> VarsOpts -> IO ()+explainMode modName vopts = do+ -- Load the full composition (target module + transitive dependencies)+ searchPaths <- defaultSearchPaths+ compositionResult <- loadComposition searchPaths modName []+ modulesInOrder <- case compositionResult of+ Left (ModuleNotFound name searched) -> do+ logIO LogNormal $ do+ logError $ "Module '" <> name.unModuleName <> "' not found."+ logError "Searched in:"+ mapM_ (\p -> logError $ " " <> T.pack p) searched+ exitFailure+ Left (CircularDependency names) -> do+ logIO LogNormal $ do+ logError "Circular dependency detected:"+ logError $ " " <> T.intercalate " -> " (map (.unModuleName) names)+ exitFailure+ Left err -> do+ logIO LogNormal (logError $ T.pack (show err))+ exitFailure+ Right ms -> pure ms++ -- Report composition when multiple modules are involved+ when (length modulesInOrder > 1) $+ logIO LogNormal $+ logInfo $+ "Resolving with "+ <> T.pack (show (length modulesInOrder))+ <> " modules in composition"++ -- Resolve variables with the full composition pipeline+ envPairs <- getEnvironment+ let cliOverrides = Map.fromList [(VarName k, v) | (k, v) <- vopts.varsVars]+ envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]+ namespace = fromMaybe (deriveNamespace modName) vopts.varsNamespace+ context <- resolveContext vopts.varsContext envVars+ let contextName = fromMaybe "" context+ (resolveResult, localMap, nsMap, ctxMap, globalMap) <- runEff $ runConfigReader $ runConsole $ do+ localCfg <- readLocalConfig >>= unwrapConfig LogNormal+ namespaceCfg <- readNamespaceConfig namespace >>= unwrapConfig LogNormal+ contextCfg <- readContextConfig contextName >>= unwrapConfig LogNormal+ globalCfg <- readGlobalConfig >>= unwrapConfig LogNormal+ let lm = toVarNameMap localCfg+ nm = toVarNameMap namespaceCfg+ cm = toVarNameMap contextCfg+ gm = toVarNameMap globalCfg+ r <- resolveWithPrompts modulesInOrder cliOverrides envVars namespace contextName lm nm cm gm+ pure (r, lm, nm, cm, gm)+ case resolveResult of+ Left errs -> do+ logIO LogNormal $ do+ logError "Error resolving variables:"+ mapM_ (logError . (" " <>) . formatVarError) errs+ exitFailure+ Right resolved -> do+ -- Show only the target module's resolved variables. `seihou vars` is+ -- scoped to a module name, so if multiple instances exist we merge+ -- their resolved maps (last wins on overlap — matches how a user+ -- reads "the variables of module X" before any disambiguation UI).+ let targetResolved =+ Map.unions+ [ vs+ | (inst, vs) <- Map.toList resolved,+ inst.instanceModule == modName+ ]+ TIO.putStrLn $ "Variables for " <> modName.unModuleName <> ":"+ TIO.putStrLn ""+ if Map.null targetResolved+ then TIO.putStrLn " (no variables resolved)"+ else TIO.putStr (formatExplain targetResolved)++ -- Show diagnostics+ let allDecls = concatMap (\(_, m, _) -> m.vars) modulesInOrder+ allResolved = Map.unions [vs | vs <- Map.elems resolved]+ (unusedKeys, unresolvedOpt) = diagnoseResolution allResolved allDecls localMap nsMap ctxMap globalMap+ when (not (null unusedKeys)) $ do+ TIO.putStrLn ""+ TIO.putStrLn "Unused config keys (not matching any declared variable):"+ mapM_ (\(VarName n) -> TIO.putStrLn $ " " <> n) unusedKeys+ when (not (null unresolvedOpt)) $ do+ TIO.putStrLn ""+ TIO.putStrLn "Unresolved optional variables:"+ mapM_ (\(VarName n) -> TIO.putStrLn $ " " <> n) unresolvedOpt
+ src-exe/Seihou/CLI/Version.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++module Seihou.CLI.Version+ ( seihouVersion,+ seihouVersionWithGit,+ gitCommitShort,+ )+where++import Data.Text (Text, pack)+import Data.Version (showVersion)+import GitHash (GitInfo, giHash, tGitInfoCwdTry)+import Paths_seihou_cli (version)++seihouVersion :: Text+seihouVersion = pack (showVersion version)++-- | Git info embedded at compile time (Right if in git repo, Left with error message otherwise)+gitInfo :: Either String GitInfo+gitInfo = $$tGitInfoCwdTry++-- | Fallback git hash injected via CPP for Nix builds where .git is absent.+nixGitHash :: Maybe Text+#ifdef GIT_HASH+nixGitHash = Just GIT_HASH+#else+nixGitHash = Nothing+#endif++-- | Get the short git commit hash (first 7 characters).+-- Falls back to CPP-injected GIT_HASH for Nix builds.+gitCommitShort :: Maybe Text+gitCommitShort = case gitInfo of+ Right gi -> Just $ pack $ take 7 $ giHash gi+ Left _ -> nixGitHash++-- | Version string with git commit suffix (e.g. "seihou v0.1.0.0 (a1b2c3d)")+seihouVersionWithGit :: Text+seihouVersionWithGit = "seihou v" <> seihouVersion <> commitSuffix+ where+ commitSuffix = maybe "" (\c -> " (" <> c <> ")") gitCommitShort
+ src/Seihou/CLI/AgentCompletion.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE DerivingStrategies #-}++module Seihou.CLI.AgentCompletion+ ( AgentProvider (..),+ AgentModelConfig (..),+ AgentCompletionRequest (..),+ defaultAgentModelConfig,+ providerFromText,+ providerToText,+ buildAgentCompletionRequest,+ buildBaikaiModel,+ runAgentCompletion,+ responseText,+ )+where++import Baikai qualified+import Baikai.Provider.Claude.Api qualified as ClaudeApi+import Baikai.Provider.Claude.Cli qualified as ClaudeCli+import Baikai.Provider.OpenAI.Api qualified as OpenAIApi+import Baikai.Provider.OpenAI.Cli qualified as CodexCli+import Control.Exception (try)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector qualified as V++data AgentProvider+ = AgentProviderClaudeCli+ | AgentProviderCodexCli+ | AgentProviderAnthropic+ | AgentProviderOpenAI+ deriving stock (Eq, Show)++data AgentModelConfig = AgentModelConfig+ { agentProvider :: AgentProvider,+ agentModel :: Maybe Text+ }+ deriving stock (Eq, Show)++data AgentCompletionRequest = AgentCompletionRequest+ { completionSystemPrompt :: Text,+ completionInitialPrompt :: Maybe Text,+ completionModelConfig :: AgentModelConfig+ }+ deriving stock (Eq, Show)++buildAgentCompletionRequest :: AgentModelConfig -> Text -> Maybe Text -> AgentCompletionRequest+buildAgentCompletionRequest modelConfig systemPrompt initialPrompt =+ AgentCompletionRequest+ { completionSystemPrompt = systemPrompt,+ completionInitialPrompt = initialPrompt,+ completionModelConfig = modelConfig+ }++defaultAgentModelConfig :: AgentModelConfig+defaultAgentModelConfig =+ AgentModelConfig+ { agentProvider = AgentProviderClaudeCli,+ agentModel = Nothing+ }++providerFromText :: Text -> Either Text AgentProvider+providerFromText raw =+ case Text.toLower (Text.strip raw) of+ "claude-cli" -> Right AgentProviderClaudeCli+ "codex-cli" -> Right AgentProviderCodexCli+ "anthropic" -> Right AgentProviderAnthropic+ "openai" -> Right AgentProviderOpenAI+ other ->+ Left $+ "Unknown agent provider '"+ <> other+ <> "'. Expected one of: claude-cli, codex-cli, anthropic, openai."++providerToText :: AgentProvider -> Text+providerToText AgentProviderClaudeCli = "claude-cli"+providerToText AgentProviderCodexCli = "codex-cli"+providerToText AgentProviderAnthropic = "anthropic"+providerToText AgentProviderOpenAI = "openai"++buildBaikaiModel :: AgentModelConfig -> Baikai.Model+buildBaikaiModel config =+ case config.agentProvider of+ AgentProviderClaudeCli ->+ baseCliModel+ { Baikai.modelId = maybe "" id config.agentModel,+ Baikai.name = maybe "Claude CLI default" id config.agentModel,+ Baikai.api = Baikai.AnthropicMessagesCli,+ Baikai.provider = "anthropic"+ }+ AgentProviderCodexCli ->+ baseCliModel+ { Baikai.modelId = maybe "" id config.agentModel,+ Baikai.name = maybe "Codex CLI default" id config.agentModel,+ Baikai.api = Baikai.OpenAICompletionsCli,+ Baikai.provider = "openai"+ }+ AgentProviderAnthropic ->+ Baikai.emptyModel+ { Baikai.modelId = maybe "claude-sonnet-4-6" id config.agentModel,+ Baikai.name = maybe "Claude Sonnet 4.6" id config.agentModel,+ Baikai.api = Baikai.AnthropicMessages,+ Baikai.provider = "anthropic",+ Baikai.baseUrl = "https://api.anthropic.com"+ }+ AgentProviderOpenAI ->+ Baikai.emptyModel+ { Baikai.modelId = maybe "gpt-4o-mini" id config.agentModel,+ Baikai.name = maybe "GPT-4o Mini" id config.agentModel,+ Baikai.api = Baikai.OpenAIChatCompletions,+ Baikai.provider = "openai",+ Baikai.baseUrl = "https://api.openai.com"+ }+ where+ baseCliModel =+ Baikai.emptyModel+ { Baikai.contextWindow = 0,+ Baikai.maxOutputTokens = 0+ }++runAgentCompletion :: AgentCompletionRequest -> IO (Either Text Text)+runAgentCompletion req = do+ registerAgentProviders+ initialMessages <-+ maybe+ (pure V.empty)+ (fmap V.singleton . Baikai.userNow)+ req.completionInitialPrompt+ let model = buildBaikaiModel req.completionModelConfig+ ctx =+ Baikai.emptyContext+ { Baikai.systemPrompt = Just req.completionSystemPrompt,+ Baikai.messages = initialMessages+ }+ result <- try (Baikai.completeRequest model ctx Baikai.emptyOptions) :: IO (Either Baikai.BaikaiError Baikai.Response)+ pure $ case result of+ Left err -> Left (Text.pack (show err))+ Right resp ->+ let body = responseText resp+ in if Text.null (Text.strip body)+ then Left "Provider returned no assistant text."+ else Right body++responseText :: Baikai.Response -> Text+responseText =+ Text.intercalate "\n"+ . V.toList+ . V.mapMaybe assistantText+ . Baikai.flattenAssistantBlocks+ where+ assistantText (Baikai.AssistantText (Baikai.TextContent t)) = Just t+ assistantText _ = Nothing++registerAgentProviders :: IO ()+registerAgentProviders = do+ ClaudeCli.register+ CodexCli.register+ ClaudeApi.register+ OpenAIApi.register
+ src/Seihou/CLI/AgentConfig.hs view
@@ -0,0 +1,93 @@+module Seihou.CLI.AgentConfig+ ( AgentConfigInputs (..),+ agentProviderConfigKey,+ agentModelConfigKey,+ agentProviderEnvVar,+ agentModelEnvVar,+ resolveAgentModelConfig,+ loadAgentModelConfig,+ )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.CLI.AgentCompletion+ ( AgentModelConfig (..),+ defaultAgentModelConfig,+ providerFromText,+ )+import Seihou.CLI.Shared (formatConfigError)+import Seihou.Effect.ConfigReader (readGlobalConfig, readLocalConfig)+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Prelude+import System.Environment (lookupEnv)++data AgentConfigInputs = AgentConfigInputs+ { cliProvider :: Maybe Text,+ cliModel :: Maybe Text,+ envProvider :: Maybe Text,+ envModel :: Maybe Text,+ localConfig :: Map Text Text,+ globalConfig :: Map Text Text+ }+ deriving stock (Eq, Show)++agentProviderConfigKey :: Text+agentProviderConfigKey = "agent.provider"++agentModelConfigKey :: Text+agentModelConfigKey = "agent.model"++agentProviderEnvVar :: String+agentProviderEnvVar = "SEIHOU_AGENT_PROVIDER"++agentModelEnvVar :: String+agentModelEnvVar = "SEIHOU_AGENT_MODEL"++resolveAgentModelConfig :: AgentConfigInputs -> Either Text AgentModelConfig+resolveAgentModelConfig inputs = do+ provider <-+ maybe+ (Right defaultAgentModelConfig.agentProvider)+ providerFromText+ (firstNonBlank [inputs.cliProvider, inputs.envProvider, configValue inputs.localConfig agentProviderConfigKey, configValue inputs.globalConfig agentProviderConfigKey])+ pure+ AgentModelConfig+ { agentProvider = provider,+ agentModel = firstNonBlank [inputs.cliModel, inputs.envModel, configValue inputs.localConfig agentModelConfigKey, configValue inputs.globalConfig agentModelConfigKey]+ }++loadAgentModelConfig :: Maybe Text -> Maybe Text -> IO (Either Text AgentModelConfig)+loadAgentModelConfig cliProvider cliModel = do+ envProvider <- fmap T.pack <$> lookupEnv agentProviderEnvVar+ envModel <- fmap T.pack <$> lookupEnv agentModelEnvVar+ (localResult, globalResult) <- runEff $ runConfigReader $ do+ local <- readLocalConfig+ global <- readGlobalConfig+ pure (local, global)+ pure $ do+ local <- first formatConfigError localResult+ global <- first formatConfigError globalResult+ resolveAgentModelConfig+ AgentConfigInputs+ { cliProvider = cliProvider,+ cliModel = cliModel,+ envProvider = envProvider,+ envModel = envModel,+ localConfig = local,+ globalConfig = global+ }++configValue :: Map Text Text -> Text -> Maybe Text+configValue config key = Map.lookup key config++firstNonBlank :: [Maybe Text] -> Maybe Text+firstNonBlank =+ foldr+ ( \candidate acc ->+ case T.strip <$> candidate of+ Just "" -> acc+ Just value -> Just value+ Nothing -> acc+ )+ Nothing
+ src/Seihou/CLI/AgentLaunch.hs view
@@ -0,0 +1,260 @@+module Seihou.CLI.AgentLaunch+ ( AgentContext (..),+ BaselineStatus (..),+ gatherAgentContext,+ defaultAllowedTools,+ setupAllowedTools,+ bootstrapAllowedTools,+ substitute,+ formatSeihouProjectState,+ formatManifestState,+ formatModuleDhallState,+ formatLocalModules,+ formatAvailableModules,+ formatBlueprintIdentity,+ formatBaselineStatus,+ formatReferenceFiles,+ formatReferenceFilesDir,+ resolveBlueprintTools,+ )+where++import Data.List (nub)+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Seihou.Core.Module (DiscoveredModule (..), ModuleSource (..), defaultSearchPaths, discoverAllModules)+import Seihou.Core.Types+import Seihou.Prelude+import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory)++-- | Dynamic context gathered from the current directory, shared across agent commands.+data AgentContext = AgentContext+ { cwd :: Text,+ seihouInitialized :: Bool,+ hasManifest :: Bool,+ localModuleDhall :: Bool,+ localModules :: [Text],+ -- | (name, description, source)+ availableModules :: [(Text, Text, Text)]+ }++gatherAgentContext :: IO AgentContext+gatherAgentContext = do+ cwd <- T.pack <$> getCurrentDirectory+ seihouInitialized <- doesDirectoryExist (T.unpack cwd </> ".seihou")+ hasManifest <- doesFileExist (T.unpack cwd </> ".seihou" </> "manifest.json")+ localModuleDhall <- doesFileExist (T.unpack cwd </> "module.dhall")++ localMods <- findLocalModuleDirs (T.unpack cwd)++ searchPaths <- defaultSearchPaths+ discovered <- discoverAllModules searchPaths+ let available = concatMap toModuleInfo discovered++ pure+ AgentContext+ { cwd = cwd,+ seihouInitialized = seihouInitialized,+ hasManifest = hasManifest,+ localModuleDhall = localModuleDhall,+ localModules = localMods,+ availableModules = available+ }++-- | Default allowed tools for agent commands (assist, bootstrap).+defaultAllowedTools :: [String]+defaultAllowedTools =+ [ "Bash(seihou *)",+ "Bash(git *)",+ "Bash(ls *)",+ "Bash(mkdir *)",+ "Bash(cat *)",+ "Bash(pwd)",+ "Read",+ "Write",+ "Edit",+ "Glob",+ "Grep",+ "EnterWorktree",+ "ExitWorktree"+ ]++-- | Allowed tools for the setup command — grants full git and seihou access+-- since setup needs to init repos, stage files, commit, and run any seihou command.+setupAllowedTools :: [String]+setupAllowedTools =+ [ "Bash(seihou *)",+ "Bash(git *)",+ "Bash(ls *)",+ "Bash(mkdir *)",+ "Bash(cat *)",+ "Bash(pwd)",+ "Read",+ "Write",+ "Edit",+ "Glob",+ "Grep",+ "EnterWorktree",+ "ExitWorktree"+ ]++-- | Allowed tools for the bootstrap command — grants full git access, temp directories,+-- and common shell utilities so the agent can scaffold, test, and commit without prompting.+bootstrapAllowedTools :: [String]+bootstrapAllowedTools =+ [ "Bash(seihou *)",+ "Bash(git *)",+ "Bash(ls *)",+ "Bash(mkdir *)",+ "Bash(cat *)",+ "Bash(pwd)",+ "Bash(mktemp *)",+ "Bash(cp *)",+ "Bash(rm *)",+ "Bash(mv *)",+ "Bash(touch *)",+ "Bash(tree *)",+ "Bash(find *)",+ "Bash(wc *)",+ "Bash(diff *)",+ "Bash(head *)",+ "Bash(tail *)",+ "Bash(echo *)",+ "Bash(chmod *)",+ "Read",+ "Write",+ "Edit",+ "Glob",+ "Grep",+ "EnterWorktree",+ "ExitWorktree"+ ]++-- | Simple {{key}} substitution. Replaces each {{key}} with the corresponding value.+substitute :: [(Text, Text)] -> Text -> Text+substitute vars template = foldl' replaceOne template vars+ where+ replaceOne t (key, val) = T.replace ("{{" <> key <> "}}") val t++-- Shared context formatters++formatSeihouProjectState :: AgentContext -> Text+formatSeihouProjectState ctx+ | ctx.seihouInitialized = "Seihou project: .seihou/ directory exists (this is a seihou-managed project)"+ | otherwise = "Seihou project: No .seihou/ directory (not yet a seihou project in this directory)"++formatManifestState :: AgentContext -> Text+formatManifestState ctx+ | ctx.hasManifest = "Manifest: .seihou/manifest.json exists (modules have been applied here)"+ | otherwise = "Manifest: No manifest (no modules applied yet)"++formatModuleDhallState :: AgentContext -> Text+formatModuleDhallState ctx+ | ctx.localModuleDhall = "Module in cwd: module.dhall found in current directory (user is authoring a module here)"+ | otherwise = ""++formatLocalModules :: AgentContext -> Text+formatLocalModules ctx+ | null ctx.localModules = ""+ | otherwise = T.intercalate "\n" $ "Local modules:" : map (" - " <>) ctx.localModules++formatAvailableModules :: AgentContext -> Text+formatAvailableModules ctx+ | null ctx.availableModules = "Available modules: None discovered"+ | otherwise =+ T.intercalate "\n" $+ "Available modules across search paths:"+ : map formatMod ctx.availableModules+ where+ formatMod (name, desc, src) = " - " <> name <> " — " <> desc <> " (" <> src <> ")"++-- Internal helpers++findLocalModuleDirs :: FilePath -> IO [Text]+findLocalModuleDirs dir = do+ let seihouModsDir = dir </> ".seihou" </> "modules"+ hasSeihouMods <- doesDirectoryExist seihouModsDir+ if hasSeihouMods+ then pure ["(project modules directory exists at .seihou/modules/)"]+ else pure []++toModuleInfo :: DiscoveredModule -> [(Text, Text, Text)]+toModuleInfo dm = case dm.discoveredResult of+ Right m ->+ [ ( m.name.unModuleName,+ maybe "(no description)" id m.description,+ sourceLabel dm.discoveredSource+ )+ ]+ Left _ -> []++sourceLabel :: ModuleSource -> Text+sourceLabel SourceProject = "project"+sourceLabel SourceUser = "user"+sourceLabel SourceInstalled = "installed"++-- | Outcome of the optional baseline-application phase in+-- @seihou agent run@. Captured here in the library so the runner+-- (in @src-exe@) and the formatter share one shape.+data BaselineStatus+ = -- | The user passed @--no-baseline@; the runner skipped baseline application entirely.+ BaselineSkipped+ | -- | The blueprint declared no @baseModules@; nothing to apply.+ BaselineEmpty+ | -- | Baseline modules were applied. Each entry is the module's name and (optional) version.+ BaselineApplied [(ModuleName, Maybe Text)]+ deriving stock (Eq, Show)++-- | Render a blueprint's identity (name, version, description) as the+-- block embedded under "## Blueprint Identity" in the agent's system prompt.+formatBlueprintIdentity :: Blueprint -> Text+formatBlueprintIdentity bp =+ T.intercalate+ "\n"+ [ "Name: " <> bp.name.unModuleName,+ "Version: " <> fromMaybe "(unspecified)" bp.version,+ "Description: " <> fromMaybe "(no description)" bp.description+ ]++-- | Render the "## Baseline" body for the agent prompt.+formatBaselineStatus :: BaselineStatus -> Text+formatBaselineStatus BaselineSkipped =+ "(no baseline applied — `--no-baseline` was passed)"+formatBaselineStatus BaselineEmpty =+ "(this blueprint declares no base modules)"+formatBaselineStatus (BaselineApplied entries) =+ T.intercalate "\n" (map render entries)+ where+ render (n, Just v) = " - " <> n.unModuleName <> " (v" <> v <> ")"+ render (n, Nothing) = " - " <> n.unModuleName <> " (unversioned)"++-- | Render a blueprint's @files@ list as the body of the+-- "## Reference Files" block. When the directory exists, the interactive+-- runner mounts it via @--add-dir@ and 'formatReferenceFilesDir' prints its+-- path; this list helps the agent pick the right reference for the request.+formatReferenceFiles :: [BlueprintFile] -> Text+formatReferenceFiles [] = "(no reference files)"+formatReferenceFiles bfs = T.intercalate "\n" (map render bfs)+ where+ render bf = case bf.description of+ Just d -> " - " <> T.pack bf.src <> " — " <> d+ Nothing -> " - " <> T.pack bf.src++-- | Render guidance for the blueprint's reference-files directory. A+-- present path means the directory is mounted and readable by the interactive+-- agent; 'Nothing' means the provider cannot access it in this session.+formatReferenceFilesDir :: Maybe FilePath -> Text+formatReferenceFilesDir (Just dir) =+ "These files are readable at: "+ <> T.pack dir+ <> " — open them directly with your file tools before asking the user."+formatReferenceFilesDir Nothing =+ "These files are not mounted in this session; ask the user to paste any "+ <> "reference you need and never claim to have read one."++-- | Effective pre-approved tools for a blueprint run: the base set every+-- blueprint needs plus any tools it declares, de-duplicated and base-first.+-- No declaration yields exactly 'setupAllowedTools'.+resolveBlueprintTools :: Maybe [Text] -> [String]+resolveBlueprintTools declared =+ nub (setupAllowedTools <> map T.unpack (fromMaybe [] declared))
+ src/Seihou/CLI/AppliedBlueprint.hs view
@@ -0,0 +1,45 @@+-- | Persist 'AppliedBlueprint' provenance to a project's+-- @.seihou/manifest.json@. The runner in @src-exe/Seihou/CLI/AgentRun.hs@+-- assembles an 'AppliedBlueprint' after a successful agent session and+-- delegates the actual read-modify-write to 'recordAppliedBlueprint'.+-- Keeping this helper in @seihou-cli-internal@ (rather than next to the+-- runner) lets the test suite cover it directly: the @seihou@+-- executable target is trapped by @Options.Applicative@/@Data.FileEmbed@+-- and is not importable by @seihou-cli-test@.+module Seihou.CLI.AppliedBlueprint+ ( recordAppliedBlueprint,+ )+where++import Seihou.Core.Types (AppliedBlueprint (..))+import Seihou.Effect.Filesystem (createDirectoryIfMissing)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.ManifestStore (readManifest, writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Manifest.Types (emptyManifest, writeAppliedBlueprint)+import Seihou.Prelude+import System.FilePath (takeDirectory)++-- | Read the manifest at @manifestPath@, attach the supplied+-- 'AppliedBlueprint' as the project's blueprint provenance, and write+-- the manifest back. If no manifest exists yet, a fresh one is created+-- using the entry's @appliedAt@ timestamp as its @genAt@.+--+-- Returns @Left err@ when the existing manifest cannot be parsed —+-- callers should leave the manifest untouched in that case rather than+-- silently overwriting a hand-edited file. The directory containing+-- the manifest is created if missing, mirroring the pre-existing+-- @applyBaseline@ flow.+recordAppliedBlueprint :: FilePath -> AppliedBlueprint -> IO (Either Text ())+recordAppliedBlueprint manifestPath ab =+ runEff $ runFilesystem $ runManifestStore manifestPath $ do+ createDirectoryIfMissing True (takeDirectory manifestPath)+ mManifest <- readManifest+ case mManifest of+ Right (Just m) -> do+ writeManifest (writeAppliedBlueprint ab m)+ pure (Right ())+ Right Nothing -> do+ writeManifest (writeAppliedBlueprint ab (emptyManifest ab.appliedAt))+ pure (Right ())+ Left err -> pure (Left err)
+ src/Seihou/CLI/BrowseFormat.hs view
@@ -0,0 +1,105 @@+module Seihou.CLI.BrowseFormat+ ( formatBrowseRegistry,+ formatBrowseSingleModule,+ formatBrowseSingleBlueprint,+ formatBrowseSinglePrompt,+ kindLabel,+ )+where++import Data.Text qualified as T+import Seihou.Core.Registry (EntryKind (..), Registry (..), RegistryEntry (..))+import Seihou.Core.Types (ModuleName (..))+import Seihou.Prelude++-- | Display-string label for an 'EntryKind'. Each label is padded to+-- eleven characters so registry rows line up regardless of which kind+-- appears on a given row.+kindLabel :: EntryKind -> Text+kindLabel ModuleEntry = "[module] "+kindLabel RecipeEntry = "[recipe] "+kindLabel BlueprintEntry = "[blueprint]"+kindLabel PromptEntry = "[prompt] "++-- | Format browse output for a multi-module registry. Each row begins+-- with a per-kind label so the user can see at a glance whether they are+-- selecting a module, recipe, or blueprint.+formatBrowseRegistry :: Text -> Registry -> [(EntryKind, RegistryEntry)] -> Maybe Text -> Text+formatBrowseRegistry source registry filtered tagFilter =+ let header =+ registry.repoName+ <> "\n"+ <> maybe "" (<> "\n") registry.repoDescription+ <> "\n"+ in if null filtered+ then+ header+ <> ( case tagFilter of+ Just tag -> "No entries matching tag '" <> tag <> "'.\n"+ Nothing -> "No entries in registry.\n"+ )+ else+ let nameOf e = let (ModuleName n) = e.name in n+ maxNameLen = maximum (map (T.length . nameOf . snd) filtered)+ entryLines = T.unlines (map (formatEntry maxNameLen) filtered)+ n = length filtered+ noun = if n == 1 then "entry" else "entries"+ footer =+ T.pack (show n)+ <> " "+ <> noun+ <> " available. Install with:\n"+ <> " seihou install "+ <> source+ <> " --module <name>\n"+ <> " seihou install "+ <> source+ <> " --all\n"+ in header <> "Available entries:\n\n" <> entryLines <> "\n" <> footer++-- | Format browse output for a single-module repo.+formatBrowseSingleModule :: Text -> Text -> Maybe Text -> Text+formatBrowseSingleModule source name desc =+ name+ <> "\n"+ <> maybe "" (\d -> " " <> d <> "\n") desc+ <> "\n"+ <> "Single-module repository. Install with:\n"+ <> " seihou install "+ <> source+ <> "\n"++-- | Format browse output for a single-blueprint repo.+formatBrowseSingleBlueprint :: Text -> Text -> Maybe Text -> Text+formatBrowseSingleBlueprint source name desc =+ name+ <> "\n"+ <> maybe "" (\d -> " " <> d <> "\n") desc+ <> "\n"+ <> "Single-blueprint repository. Install with:\n"+ <> " seihou install "+ <> source+ <> "\n"++-- | Format browse output for a single-prompt repo.+formatBrowseSinglePrompt :: Text -> Text -> Maybe Text -> Text+formatBrowseSinglePrompt source name desc =+ name+ <> "\n"+ <> maybe "" (\d -> " " <> d <> "\n") desc+ <> "\n"+ <> "Single-prompt repository. Install with:\n"+ <> " seihou install "+ <> source+ <> "\n"++formatEntry :: Int -> (EntryKind, RegistryEntry) -> Text+formatEntry maxNameLen (kind, entry) =+ let (ModuleName name) = entry.name+ padding = T.replicate (maxNameLen - T.length name + 3) " "+ desc = maybe "" id entry.description+ tagsText =+ if null entry.tags+ then ""+ else " [" <> T.intercalate ", " entry.tags <> "]"+ in " " <> kindLabel kind <> " " <> name <> padding <> desc <> tagsText
+ src/Seihou/CLI/CommitMessage.hs view
@@ -0,0 +1,93 @@+module Seihou.CLI.CommitMessage+ ( generateCommitMessage,+ stripCodeFence,+ )+where++import Control.Exception (SomeException, try)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Core.Types (ModuleName (..))+import System.Directory (findExecutable)+import System.Exit (ExitCode (..))+import System.IO (hClose)+import System.Process (CreateProcess (..), StdStream (..), createProcess, proc, waitForProcess)++-- | Generate a commit message using Claude Code CLI.+-- Takes the module names applied and the staged diff.+-- Returns the AI-generated message, or a fallback if claude is unavailable.+generateCommitMessage :: [ModuleName] -> T.Text -> IO T.Text+generateCommitMessage modNames diffText = do+ claudePath <- findExecutable "claude"+ case claudePath of+ Nothing -> pure (fallbackMessage modNames)+ Just _ -> do+ result <- callClaude modNames diffText+ case result of+ Nothing -> pure (fallbackMessage modNames)+ Just msg+ | T.null (T.strip msg) -> pure (fallbackMessage modNames)+ | otherwise -> pure (stripCodeFence (T.strip msg))++callClaude :: [ModuleName] -> T.Text -> IO (Maybe T.Text)+callClaude modNames diffText = do+ let prompt = buildPrompt modNames diffText+ cp =+ (proc "claude" ["-p", T.unpack prompt])+ { std_out = CreatePipe,+ std_err = CreatePipe,+ std_in = NoStream+ }+ result <- try @SomeException $ do+ (_, Just hOut, Just hErr, ph) <- createProcess cp+ output <- TIO.hGetContents hOut+ _ <- TIO.hGetContents hErr+ exitCode <- waitForProcess ph+ hClose hOut+ hClose hErr+ pure (exitCode, output)+ case result of+ Left _ -> pure Nothing+ Right (ExitSuccess, output) -> pure (Just output)+ Right (ExitFailure _, _) -> pure Nothing++buildPrompt :: [ModuleName] -> T.Text -> T.Text+buildPrompt modNames diffText =+ T.unlines+ [ "Generate a concise git commit message for seihou scaffolding changes.",+ "",+ "Modules applied: " <> moduleList,+ "",+ "Staged changes:",+ diffText,+ "",+ "Rules:",+ "- Use conventional commit style (e.g., \"feat: ...\", \"chore: ...\")",+ "- Keep the subject line under 72 characters",+ "- Mention which seihou module(s) were applied",+ "- Output ONLY the commit message, nothing else",+ "- Do not wrap the output in backticks or code fences"+ ]+ where+ moduleList = T.intercalate ", " (map (.unModuleName) modNames)++-- | Strip markdown code-fence wrapping (``` ... ```) from text.+-- Handles optional language tags (e.g., ```text).+stripCodeFence :: T.Text -> T.Text+stripCodeFence txt =+ let ls = T.lines txt+ nonEmpty = filter (not . T.null . T.strip) ls+ in case nonEmpty of+ (first : rest)+ | "```" `T.isPrefixOf` first,+ not (null rest),+ T.strip (last rest) == "```" ->+ let -- Drop the opening fence line and closing fence line+ body = drop 1 (take (length ls - 1) ls)+ in T.strip (T.unlines body)+ _ -> txt++fallbackMessage :: [ModuleName] -> T.Text+fallbackMessage [] = "seihou: apply modules"+fallbackMessage [m] = "seihou: apply module " <> m.unModuleName+fallbackMessage ms = "seihou: apply modules " <> T.intercalate ", " (map (.unModuleName) ms)
+ src/Seihou/CLI/Completions/Bash.hs view
@@ -0,0 +1,25 @@+module Seihou.CLI.Completions.Bash+ ( generateBashCompletion,+ )+where++import Data.Text qualified as T+import Seihou.Prelude++generateBashCompletion :: Text+generateBashCompletion =+ T.unlines+ [ "_seihou_completions() {",+ " local CMDLINE",+ " local IFS=$'\\n'",+ " CMDLINE=(--bash-completion-index $COMP_CWORD)",+ "",+ " for arg in ${COMP_WORDS[@]}; do",+ " CMDLINE=(${CMDLINE[@]} --bash-completion-word \"$arg\")",+ " done",+ "",+ " COMPREPLY=( $(seihou \"${CMDLINE[@]}\" 2>/dev/null) )",+ "}",+ "",+ "complete -o filenames -F _seihou_completions seihou"+ ]
+ src/Seihou/CLI/Completions/Fish.hs view
@@ -0,0 +1,38 @@+module Seihou.CLI.Completions.Fish+ ( generateFishCompletion,+ )+where++import Data.Text qualified as T+import Seihou.Prelude++generateFishCompletion :: Text+generateFishCompletion =+ T.unlines+ [ "# Disable file completion by default",+ "complete -c seihou -f",+ "",+ "function __seihou_complete",+ " set -l tokens (commandline -cop)",+ " set -l current (commandline -ct)",+ " set -l index (count $tokens)",+ "",+ " set -l args --bash-completion-enriched --bash-completion-index $index",+ " for token in $tokens",+ " set args $args --bash-completion-word $token",+ " end",+ " set args $args --bash-completion-word \"$current\"",+ "",+ " for line in (seihou $args 2>/dev/null)",+ " # Split on tab: word<TAB>description",+ " set -l parts (string split \\t -- $line)",+ " if test (count $parts) -ge 2",+ " printf '%s\\t%s\\n' $parts[1] $parts[2]",+ " else",+ " echo $line",+ " end",+ " end",+ "end",+ "",+ "complete -c seihou -a '(__seihou_complete)'"+ ]
+ src/Seihou/CLI/Completions/Zsh.hs view
@@ -0,0 +1,42 @@+module Seihou.CLI.Completions.Zsh+ ( generateZshCompletion,+ )+where++import Data.Text qualified as T+import Seihou.Prelude++generateZshCompletion :: Text+generateZshCompletion =+ T.unlines+ [ "#compdef seihou",+ "",+ "_seihou() {",+ " local -a completions",+ " local CMDLINE",+ " local IFS=$'\\n'",+ "",+ " CMDLINE=(--bash-completion-enriched --bash-completion-index $((CURRENT - 1)))",+ "",+ " for arg in ${words[@]}; do",+ " CMDLINE=(${CMDLINE[@]} --bash-completion-word \"$arg\")",+ " done",+ "",+ " local line",+ " for line in $(seihou \"${CMDLINE[@]}\" 2>/dev/null); do",+ " local word=${line%%$'\\t'*}",+ " local desc=${line#*$'\\t'}",+ " if [[ \"$word\" != \"$desc\" ]]; then",+ " completions+=(\"${word//:/\\\\:}:${desc}\")",+ " else",+ " completions+=(\"$word\")",+ " fi",+ " done",+ "",+ " if [[ ${#completions[@]} -gt 0 ]]; then",+ " _describe 'seihou' completions",+ " fi",+ "}",+ "",+ "_seihou"+ ]
+ src/Seihou/CLI/Diff.hs view
@@ -0,0 +1,80 @@+module Seihou.CLI.Diff+ ( handleDiff,+ formatDiffOutput,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Shared (logIO)+import Seihou.CLI.Style (dim, red, useColor, yellow)+import Seihou.Core.Status (computeTrackedFileStatuses)+import Seihou.Core.Types+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.Logger (logError)+import Seihou.Effect.ManifestStore (readManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Prelude+import System.Exit (exitFailure)++handleDiff :: IO ()+handleDiff = do+ let manifestPath = ".seihou" </> "manifest.json"++ result <- runEff $ runFilesystem $ runManifestStore manifestPath $ do+ mResult <- readManifest+ case mResult of+ Left err -> pure (Left err)+ Right Nothing -> pure (Right Nothing)+ Right (Just manifest) -> do+ tracked <- computeTrackedFileStatuses manifest+ pure (Right (Just tracked))++ colorEnabled <- useColor++ case result of+ Left err -> do+ logIO LogNormal (logError $ "Error reading manifest: " <> err)+ exitFailure+ Right Nothing ->+ TIO.putStrLn "No Seihou manifest found. Run 'seihou run <module>' to generate a project."+ Right (Just tracked) ->+ TIO.putStr (formatDiffOutput colorEnabled tracked)++formatDiffOutput :: Bool -> [TrackedFile] -> Text+formatDiffOutput color tracked =+ let modified = filter (\t -> t.status == TfsModified) tracked+ deleted = filter (\t -> t.status == TfsDeleted) tracked+ unchanged = filter (\t -> t.status == TfsUnchanged) tracked+ nMod = length modified+ nDel = length deleted+ nUnch = length unchanged+ changed = modified ++ deleted+ in if null changed+ then "No changes since last generation.\n"+ else+ let maxPathLen = maximum (map (length . (.path)) changed)+ header = "Seihou Diff:\n"+ fileLines = map (formatLine color maxPathLen) changed+ summary =+ " "+ <> T.pack (show nUnch)+ <> " unchanged, "+ <> T.pack (show nMod)+ <> " modified, "+ <> T.pack (show nDel)+ <> " deleted\n"+ in header <> "\n" <> T.unlines fileLines <> "\n" <> summary++formatLine :: Bool -> Int -> TrackedFile -> Text+formatLine color maxPathLen tf =+ let (label, colorFn) = case tf.status of+ TfsModified -> ("modified", yellow)+ TfsDeleted -> ("deleted ", red)+ TfsUnchanged -> ("unchanged", dim)+ path = T.pack tf.path+ modName = tf.moduleName.unModuleName+ paddedLabel = if color then colorFn label else label+ paddedPath = path <> T.replicate (maxPathLen - T.length path + 3) " "+ modAttr = if color then dim ("(" <> modName <> ")") else "(" <> modName <> ")"+ in " " <> paddedLabel <> " " <> paddedPath <> modAttr
+ src/Seihou/CLI/Extension.hs view
@@ -0,0 +1,57 @@+module Seihou.CLI.Extension+ ( ExtensionRunOpts (..),+ ExtensionRunError (..),+ extensionExecutableName,+ runExtension,+ handleExtensionRun,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Prelude+import System.Directory (findExecutable)+import System.Exit (ExitCode (..), exitWith)+import System.IO (hPutStrLn, stderr)+import System.Process (rawSystem)++data ExtensionRunOpts = ExtensionRunOpts+ { extensionName :: Text,+ extensionArgs :: [String]+ }+ deriving stock (Eq, Show)++data ExtensionRunError+ = ExtensionNotFound Text String+ | ExtensionExited Text ExitCode+ deriving stock (Eq, Show)++extensionExecutableName :: Text -> String+extensionExecutableName name =+ "seihou-" <> T.unpack name <> "-extension"++runExtension :: ExtensionRunOpts -> IO (Either ExtensionRunError ())+runExtension opts = do+ let exeName = extensionExecutableName opts.extensionName+ found <- findExecutable exeName+ case found of+ Nothing ->+ pure (Left (ExtensionNotFound opts.extensionName exeName))+ Just exePath -> do+ code <- rawSystem exePath opts.extensionArgs+ pure $ case code of+ ExitSuccess -> Right ()+ failure -> Left (ExtensionExited opts.extensionName failure)++handleExtensionRun :: ExtensionRunOpts -> IO ()+handleExtensionRun opts = do+ result <- runExtension opts+ case result of+ Right () ->+ pure ()+ Left (ExtensionNotFound _ exeName) -> do+ hPutStrLn stderr ("error: extension executable not found: " <> exeName)+ exitWith (ExitFailure 127)+ Left (ExtensionExited name code) -> do+ TIO.hPutStrLn stderr ("error: extension '" <> name <> "' exited with " <> T.pack (show code))+ exitWith code
+ src/Seihou/CLI/Git.hs view
@@ -0,0 +1,49 @@+module Seihou.CLI.Git+ ( isGitRepo,+ gitAdd,+ gitCommit,+ gitDiffCached,+ gitCheckIgnore,+ )+where++import Data.Text qualified as T+import Seihou.Effect.Process (Process, runProcess)+import Seihou.Prelude+import System.Exit (ExitCode (..))++-- | Check if the current directory is inside a git work tree.+isGitRepo :: (Process :> es) => Eff es Bool+isGitRepo = do+ (exitCode, _, _) <- runProcess "git" ["rev-parse", "--is-inside-work-tree"] Nothing+ pure (exitCode == ExitSuccess)++-- | Stage specific files.+gitAdd :: (Process :> es) => [FilePath] -> Eff es (ExitCode, Text, Text)+gitAdd paths =+ runProcess "git" ("add" : map T.pack paths) Nothing++-- | Create a commit with the given message.+gitCommit :: (Process :> es) => Text -> Eff es (ExitCode, Text, Text)+gitCommit msg =+ runProcess "git" ["commit", "-m", msg] Nothing++-- | Check which files are ignored by git. Returns the subset of input paths+-- that are covered by .gitignore rules.+gitCheckIgnore :: (Process :> es) => [FilePath] -> Eff es [FilePath]+gitCheckIgnore [] = pure []+gitCheckIgnore paths = do+ (exitCode, stdout', _) <- runProcess "git" ("check-ignore" : map T.pack paths) Nothing+ case exitCode of+ ExitSuccess -> pure (map T.unpack $ filter (not . T.null) $ T.lines stdout')+ _ -> pure [] -- exit 1 = no matches, exit 128 = error; both → empty++-- | Get the diff of staged changes for feeding to the commit message generator.+-- Returns a stat summary followed by the full diff (truncated to ~4000 chars).+gitDiffCached :: (Process :> es) => Eff es Text+gitDiffCached = do+ (_, stat, _) <- runProcess "git" ["diff", "--cached", "--stat"] Nothing+ (_, fullDiff, _) <- runProcess "git" ["diff", "--cached"] Nothing+ let truncatedDiff = T.take 4000 fullDiff+ suffix = if T.length fullDiff > 4000 then "\n... (diff truncated)" else ""+ pure (stat <> "\n" <> truncatedDiff <> suffix)
+ src/Seihou/CLI/Init.hs view
@@ -0,0 +1,76 @@+module Seihou.CLI.Init+ ( handleInit,+ formatInitOutput,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Shared (shortenHome)+import Seihou.Prelude+import System.Directory+ ( XdgDirectory (..),+ createDirectoryIfMissing,+ doesDirectoryExist,+ doesFileExist,+ getXdgDirectory,+ )++handleInit :: IO ()+handleInit = do+ base <- getXdgDirectory XdgConfig "seihou"+ createDirectoryIfMissing True base++ -- config.dhall+ let configPath = base </> "config.dhall"+ configExists <- doesFileExist configPath+ if configExists+ then pure ()+ else writeFile configPath defaultConfig+ let configCreated = not configExists++ -- modules/+ modulesExists <- doesDirectoryExist (base </> "modules")+ createDirectoryIfMissing True (base </> "modules")+ let modulesCreated = not modulesExists++ -- installed/+ installedExists <- doesDirectoryExist (base </> "installed")+ createDirectoryIfMissing True (base </> "installed")+ let installedCreated = not installedExists++ -- namespaces/ (internal, not reported)+ createDirectoryIfMissing True (base </> "namespaces")++ -- contexts/ (internal, not reported)+ createDirectoryIfMissing True (base </> "contexts")++ -- Output+ basePath <- shortenHome base+ let items =+ [ ("config.dhall", "global defaults", configCreated),+ ("modules/", "user modules", modulesCreated),+ ("installed/", "git-installed modules", installedCreated)+ ]+ TIO.putStr (formatInitOutput basePath items)++-- | Format the init command output. Takes the abbreviated base path and a list+-- of @(item, description, wasCreated)@ triples.+formatInitOutput :: Text -> [(Text, Text, Bool)] -> Text+formatInitOutput basePath items =+ T.unlines $+ ("Initialized Seihou configuration at " <> basePath <> "/")+ : map formatItem items+ where+ formatItem (item, desc, created) =+ let label = if created then "Created:" else "Exists: "+ in " " <> label <> " " <> item <> " (" <> desc <> ")"++defaultConfig :: String+defaultConfig =+ unlines+ [ "-- Seihou global configuration",+ "-- Add variable defaults that apply to all modules.",+ "-- Example: { `project.name` = \"my-app\", `license` = \"MIT\" }",+ "{=}"+ ]
+ src/Seihou/CLI/InstallHistory.hs view
@@ -0,0 +1,106 @@+module Seihou.CLI.InstallHistory+ ( HistoryEntry (..),+ InstallHistory (..),+ readHistory,+ readHistoryFrom,+ writeHistory,+ writeHistoryTo,+ recordUrl,+ recordUrlTo,+ maxHistoryEntries,+ )+where++import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecodeStrict', object, withObject, (.:), (.=))+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T+import Data.Time (getCurrentTime)+import Data.Time.Format.ISO8601 (iso8601Show)+import Seihou.Prelude+import System.Directory+ ( XdgDirectory (..),+ createDirectoryIfMissing,+ doesFileExist,+ getXdgDirectory,+ )+import System.FilePath (takeDirectory)++-- | A single entry in the install URL history.+data HistoryEntry = HistoryEntry+ { url :: Text,+ lastUsed :: Text+ }+ deriving stock (Eq, Show)++instance ToJSON HistoryEntry where+ toJSON e = object ["url" .= e.url, "lastUsed" .= e.lastUsed]++instance FromJSON HistoryEntry where+ parseJSON = withObject "HistoryEntry" $ \o ->+ HistoryEntry <$> o .: "url" <*> o .: "lastUsed"++-- | The full install history.+newtype InstallHistory = InstallHistory+ { entries :: [HistoryEntry]+ }+ deriving stock (Eq, Show)++instance ToJSON InstallHistory where+ toJSON h = object ["entries" .= h.entries]++instance FromJSON InstallHistory where+ parseJSON = withObject "InstallHistory" $ \o ->+ InstallHistory <$> o .: "entries"++-- | Maximum number of history entries to retain.+maxHistoryEntries :: Int+maxHistoryEntries = 50++-- | Path to the history file: ~/.config/seihou/install-history.json+historyFilePath :: IO FilePath+historyFilePath = do+ base <- getXdgDirectory XdgConfig "seihou"+ pure (base </> "install-history.json")++-- | Read history from the XDG config path. Returns empty on missing/malformed file.+readHistory :: IO InstallHistory+readHistory = historyFilePath >>= readHistoryFrom++-- | Read history from a specific file path (for testing).+readHistoryFrom :: FilePath -> IO InstallHistory+readHistoryFrom path = do+ exists <- doesFileExist path+ if not exists+ then pure (InstallHistory [])+ else do+ bs <- BS.readFile path+ case eitherDecodeStrict' bs of+ Left _ -> pure (InstallHistory [])+ Right h -> pure h++-- | Write history to the XDG config path.+writeHistory :: InstallHistory -> IO ()+writeHistory history = historyFilePath >>= \path -> writeHistoryTo path history++-- | Write history to a specific file path (for testing).+writeHistoryTo :: FilePath -> InstallHistory -> IO ()+writeHistoryTo path history = do+ createDirectoryIfMissing True (takeDirectory path)+ LBS.writeFile path (encodePretty history)++-- | Record a URL after successful install. Deduplicates, sorts recent-first, caps at 50.+recordUrl :: Text -> IO ()+recordUrl url = historyFilePath >>= \path -> recordUrlTo path url++-- | Record a URL to a specific history file (for testing).+recordUrlTo :: FilePath -> Text -> IO ()+recordUrlTo path url = do+ now <- getCurrentTime+ history <- readHistoryFrom path+ let timestamp = T.pack (iso8601Show now)+ newEntry = HistoryEntry {url = url, lastUsed = timestamp}+ filtered = filter (\e -> e.url /= url) history.entries+ updated = take maxHistoryEntries (newEntry : filtered)+ writeHistoryTo path (InstallHistory updated)
@@ -0,0 +1,147 @@+module Seihou.CLI.InstallShared+ ( -- * Origin metadata+ OriginInfo (..),+ OriginMeta (..),+ readOriginInfo,++ -- * Install primitives+ installModuleDir,+ cloneRepo,+ copyDirectoryRecursive,+ )+where++import Control.Monad (when)+import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T+import Data.Time (getCurrentTime)+import Data.Time.Format.ISO8601 (iso8601Show)+import Seihou.CLI.Shared (logIO)+import Seihou.Core.Types (LogLevel (..))+import Seihou.Effect.Logger (logWarn)+import Seihou.Prelude+import System.Directory+ ( XdgDirectory (..),+ copyFile,+ createDirectoryIfMissing,+ doesDirectoryExist,+ doesFileExist,+ getXdgDirectory,+ listDirectory,+ removeDirectoryRecursive,+ )+import System.Exit (ExitCode (..))+import System.Process (readProcessWithExitCode)++-- ----------------------------------------------------------------------------+-- Origin metadata+-- ----------------------------------------------------------------------------++-- | Read side of @.seihou-origin.json@. Tolerates files written by older+-- 'seihou install' runs that may have been missing optional fields.+data OriginInfo = OriginInfo+ { sourceUrl :: Text,+ repoName :: Maybe Text,+ version :: Maybe Text+ }+ deriving stock (Eq, Show)++instance FromJSON OriginInfo where+ parseJSON = withObject "OriginInfo" $ \v ->+ OriginInfo <$> v .: "sourceUrl" <*> v .:? "repoName" <*> v .:? "version"++-- | Read and parse @.seihou-origin.json@ at the given installed-module+-- directory. Returns 'Nothing' if the file is absent or unparseable.+readOriginInfo :: FilePath -> IO (Maybe OriginInfo)+readOriginInfo installedDir = do+ let path = installedDir </> ".seihou-origin.json"+ exists <- doesFileExist path+ if not exists+ then pure Nothing+ else do+ bs <- LBS.readFile path+ pure (Aeson.decode bs)++-- | Write side of @.seihou-origin.json@. Captures everything 'seihou+-- install' / 'seihou upgrade' want to record at install time, including+-- the timestamp.+data OriginMeta = OriginMeta+ { sourceUrl :: Text,+ repoName :: Maybe Text,+ installedAt :: Text,+ version :: Maybe Text,+ tags :: [Text]+ }++instance ToJSON OriginMeta where+ toJSON m =+ object+ [ "sourceUrl" .= m.sourceUrl,+ "repoName" .= m.repoName,+ "installedAt" .= m.installedAt,+ "version" .= m.version,+ "tags" .= m.tags+ ]++-- ----------------------------------------------------------------------------+-- Install primitives+-- ----------------------------------------------------------------------------++-- | Copy a module directory to @~/.config/seihou/installed/<name>@,+-- replacing any existing installation, and write origin metadata. The+-- source directory must already contain the module's files; this+-- function does not clone or fetch.+installModuleDir :: FilePath -> String -> Text -> Maybe Text -> Maybe Text -> [Text] -> IO ()+installModuleDir moduleDir name source registryName moduleVersion moduleTags = do+ xdgConfig <- getXdgDirectory XdgConfig "seihou"+ let installDir = xdgConfig </> "installed" </> name++ exists <- doesDirectoryExist installDir+ when exists $ do+ logIO LogNormal (logWarn $ "overwriting existing installation of '" <> T.pack name <> "'")+ removeDirectoryRecursive installDir++ createDirectoryIfMissing True installDir+ copyDirectoryRecursive moduleDir installDir++ now <- getCurrentTime+ let origin = OriginMeta source registryName (T.pack (iso8601Show now)) moduleVersion moduleTags+ LBS.writeFile (installDir </> ".seihou-origin.json") (encodePretty origin)++-- | Recursively copy a directory tree, excluding the @.git@ directory.+copyDirectoryRecursive :: FilePath -> FilePath -> IO ()+copyDirectoryRecursive src dst = do+ entries <- listDirectory src+ mapM_ (copyEntry src dst) entries+ where+ copyEntry s d entry+ | entry == ".git" = pure ()+ | otherwise = do+ let srcPath = s </> entry+ dstPath = d </> entry+ isDir <- doesDirectoryExist srcPath+ if isDir+ then do+ createDirectoryIfMissing True dstPath+ copyDirectoryRecursive srcPath dstPath+ else copyFile srcPath dstPath++-- | Clone a git repo shallowly into the target directory. Returns 'Left'+-- with a human-readable message on failure (the caller decides how to+-- recover or report). On success returns 'Right ()' with no progress+-- chatter; the caller is expected to print whatever progress message+-- fits its UX.+cloneRepo :: Text -> FilePath -> IO (Either Text ())+cloneRepo source cloneDir = do+ (exitCode, _stdout, stderr) <-+ readProcessWithExitCode "git" ["clone", "--depth", "1", T.unpack source, cloneDir] ""+ case exitCode of+ ExitFailure _ ->+ pure+ ( Left $+ "git clone failed for '" <> source <> "': " <> T.pack stderr+ )+ ExitSuccess -> pure (Right ())
+ src/Seihou/CLI/List.hs view
@@ -0,0 +1,290 @@+module Seihou.CLI.List+ ( handleList,+ formatListOutput,+ formatListOutputEntries,+ applyFilters,+ ListFilter (..),+ Entry (..),+ runnableToEntryWithOrigin,+ )+where++import Data.Aeson (FromJSON (..), withObject, (.:?))+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Shared (shortenHome)+import Seihou.CLI.Style (dim, red, useColor)+import Seihou.Core.Module (DiscoveredModule (..), DiscoveredRunnable (..), ModuleSource (..), RunnableKind (..), defaultSearchPaths, discoverAllModules, discoverAllRunnables)+import Seihou.Core.Types+import Seihou.Prelude+import System.Directory (doesFileExist)++-- | Origin metadata read from @.seihou-origin.json@.+data OriginInfo = OriginInfo+ { originRepoName :: Maybe Text,+ originVersion :: Maybe Text,+ originTags :: [Text]+ }++instance FromJSON OriginInfo where+ parseJSON = withObject "OriginInfo" $ \v ->+ OriginInfo <$> v .:? "repoName" <*> v .:? "version" <*> (fromMaybe [] <$> v .:? "tags")++-- | Filter criteria for the list command. Defined here (rather than+-- imported from Commands) so the internal library does not depend on+-- optparse-applicative.+data ListFilter = ListFilter+ { filterRepo :: Maybe Text,+ filterTag :: Maybe Text,+ filterKinds :: [RunnableKind]+ }+ deriving stock (Eq, Show)++noFilter :: ListFilter+noFilter = ListFilter Nothing Nothing []++handleList :: ListFilter -> IO ()+handleList listOpts = do+ searchPaths <- defaultSearchPaths+ runnables <- discoverAllRunnables searchPaths+ colorEnabled <- useColor+ shortenedPaths <- mapM shortenHome searchPaths+ -- Read origin metadata for installed items+ origins <- Map.fromList <$> mapM readRunnableOrigin runnables+ let entries = map (runnableToEntryWithOrigin origins) runnables+ filtered = applyFilters listOpts entries+ TIO.putStr (formatListOutputEntries colorEnabled filtered shortenedPaths listOpts)++readOrigin :: DiscoveredModule -> IO (FilePath, Maybe OriginInfo)+readOrigin dm = do+ let originFile = dm.discoveredDir </> ".seihou-origin.json"+ exists <- doesFileExist originFile+ if exists+ then do+ bs <- LBS.readFile originFile+ case Aeson.decode bs of+ Just info -> pure (dm.discoveredDir, Just info)+ Nothing -> pure (dm.discoveredDir, Nothing)+ else pure (dm.discoveredDir, Nothing)++readRunnableOrigin :: DiscoveredRunnable -> IO (FilePath, Maybe OriginInfo)+readRunnableOrigin dr = do+ let originFile = dr.drDir </> ".seihou-origin.json"+ exists <- doesFileExist originFile+ if exists+ then do+ bs <- LBS.readFile originFile+ case Aeson.decode bs of+ Just info -> pure (dr.drDir, Just info)+ Nothing -> pure (dr.drDir, Nothing)+ else pure (dr.drDir, Nothing)++runnableToEntryWithOrigin :: Map FilePath (Maybe OriginInfo) -> DiscoveredRunnable -> Entry+runnableToEntryWithOrigin origins dr =+ let (originName, originVer, originTags) = case Map.lookup dr.drDir origins of+ Just (Just info) -> (info.originRepoName, info.originVersion, info.originTags)+ _ -> (Nothing, Nothing, [])+ srcLabel = sourceLabelWithOrigin dr.drSource originName originVer+ kindSuffix = case dr.drKind of+ KindModule -> ""+ KindRecipe -> " [recipe]"+ KindBlueprint -> " [blueprint]"+ KindPrompt -> " [prompt]"+ in if dr.drIsError+ then+ Entry+ { entryName = dr.drName,+ entryDesc = "[error: " <> fromMaybe "unknown" dr.drError <> "]",+ entrySource = srcLabel <> kindSuffix,+ entryIsError = True,+ entryRepoName = originName,+ entryTags = originTags,+ entryKind = dr.drKind+ }+ else+ Entry+ { entryName = dr.drName,+ entryDesc = fromMaybe "(no description)" dr.drDescription,+ entrySource = srcLabel <> kindSuffix,+ entryIsError = False,+ entryRepoName = originName,+ entryTags = originTags,+ entryKind = dr.drKind+ }++-- | Format list output — backward-compatible version without origin info.+-- Used by tests that construct DiscoveredModule values directly.+formatListOutput :: Bool -> [DiscoveredModule] -> [Text] -> Text+formatListOutput color modules searchPaths =+ let entries = map toEntry modules+ in formatListOutputEntries color entries searchPaths noFilter++formatListOutputEntries :: Bool -> [Entry] -> [Text] -> ListFilter -> Text+formatListOutputEntries color entries searchPaths listOpts+ | null entries =+ -- With nothing to show, the kind comes from the active filter (if any).+ "No "+ <> pluralize 0 (summaryNoun listOpts.filterKinds)+ <> " found."+ <> filterSuffix+ <> "\n\nSearched:\n"+ <> T.unlines (map (" " <>) searchPaths)+ | otherwise =+ let maxNameLen = maximum (map (T.length . (.entryName)) entries)+ maxDescLen = maximum (map (T.length . (.entryDesc)) entries)+ header = "Available modules, recipes, blueprints, and prompts:\n"+ fileLines = map (formatEntry color maxNameLen maxDescLen) entries+ n = length entries+ nSources = length searchPaths+ -- The count noun reflects the kinds actually shown: a single shared+ -- kind names that kind; a mix falls back to the neutral "item".+ noun = pluralize n (summaryNoun (map (.entryKind) entries))+ summary =+ T.pack (show n)+ <> " "+ <> noun+ <> " found ("+ <> T.pack (show nSources)+ <> " sources searched)"+ <> filterSuffix+ <> "\n"+ in header <> "\n" <> T.unlines fileLines <> "\n" <> summary+ where+ filterSuffix = formatFilterSuffix listOpts++-- | Choose the singular base noun for a set of kinds. When every kind is the+-- same, name it ("module", "recipe", "blueprint"); when the set is empty or+-- mixed, fall back to the neutral "item".+summaryNoun :: [RunnableKind] -> Text+summaryNoun kinds = case kinds of+ [] -> "item"+ (k : ks)+ | all (== k) ks -> kindBase k+ | otherwise -> "item"+ where+ kindBase KindModule = "module"+ kindBase KindRecipe = "recipe"+ kindBase KindBlueprint = "blueprint"+ kindBase KindPrompt = "prompt"++-- | Append @s@ to a singular noun unless the count is exactly one.+pluralize :: Int -> Text -> Text+pluralize n base = if n == 1 then base else base <> "s"++-- | Build a display suffix describing the active filters, e.g.+-- @" [filtered: repo=foo, tag=bar]"@. Returns empty text when no filters+-- are active.+formatFilterSuffix :: ListFilter -> Text+formatFilterSuffix opts =+ let parts =+ maybe [] (\r -> ["repo=" <> r]) opts.filterRepo+ <> maybe [] (\t -> ["tag=" <> t]) opts.filterTag+ <> kindPart+ kindPart = case opts.filterKinds of+ [] -> []+ ks -> ["kind=" <> T.intercalate "+" (map kindNoun ks)]+ in if null parts+ then ""+ else " [filtered: " <> T.intercalate ", " parts <> "]"+ where+ kindNoun KindModule = "module"+ kindNoun KindRecipe = "recipe"+ kindNoun KindBlueprint = "blueprint"+ kindNoun KindPrompt = "prompt"++-- | Apply repo and tag filters to a list of entries. Both filters combine+-- with AND: an entry must match all active filters to be included.+applyFilters :: ListFilter -> [Entry] -> [Entry]+applyFilters opts = filter match+ where+ match entry = repoMatch entry && tagMatch entry && kindMatch entry+ repoMatch entry = case opts.filterRepo of+ Nothing -> True+ Just r -> entry.entryRepoName == Just r+ tagMatch entry = case opts.filterTag of+ Nothing -> True+ Just t -> t `elem` entry.entryTags+ kindMatch entry = case opts.filterKinds of+ [] -> True+ ks -> entry.entryKind `elem` ks++data Entry = Entry+ { entryName :: Text,+ entryDesc :: Text,+ entrySource :: Text,+ entryIsError :: Bool,+ entryRepoName :: Maybe Text,+ entryTags :: [Text],+ entryKind :: RunnableKind+ }+ deriving stock (Eq, Show)++toEntry :: DiscoveredModule -> Entry+toEntry = toEntryWithOrigin Map.empty++toEntryWithOrigin :: Map FilePath (Maybe OriginInfo) -> DiscoveredModule -> Entry+toEntryWithOrigin origins dm =+ let (originName, originVer, originTags) = case Map.lookup dm.discoveredDir origins of+ Just (Just info) -> (info.originRepoName, info.originVersion, info.originTags)+ _ -> (Nothing, Nothing, [])+ srcLabel = sourceLabelWithOrigin dm.discoveredSource originName originVer+ in case dm.discoveredResult of+ Right m ->+ Entry+ { entryName = m.name.unModuleName,+ entryDesc = maybe "(no description)" id m.description,+ entrySource = srcLabel,+ entryIsError = False,+ entryRepoName = originName,+ entryTags = originTags,+ entryKind = KindModule+ }+ Left err ->+ Entry+ { entryName = dirName dm.discoveredDir,+ entryDesc = "[error: " <> briefError err <> "]",+ entrySource = srcLabel,+ entryIsError = True,+ entryRepoName = originName,+ entryTags = originTags,+ entryKind = KindModule+ }++sourceLabelWithOrigin :: ModuleSource -> Maybe Text -> Maybe Text -> Text+sourceLabelWithOrigin SourceProject _ _ = "project"+sourceLabelWithOrigin SourceUser _ _ = "user"+sourceLabelWithOrigin SourceInstalled Nothing Nothing = "installed"+sourceLabelWithOrigin SourceInstalled (Just rn) Nothing = "installed: " <> rn+sourceLabelWithOrigin SourceInstalled (Just rn) (Just v) = "installed: " <> rn <> " v" <> v+sourceLabelWithOrigin SourceInstalled Nothing (Just v) = "installed v" <> v++dirName :: FilePath -> Text+dirName path = case reverse (T.splitOn "/" (T.pack path)) of+ (name : _) -> name+ [] -> T.pack path++briefError :: ModuleLoadError -> Text+briefError (DhallEvalError _ _) = "Dhall evaluation failed"+briefError (DhallDecodeError _ _) = "Dhall decode failed"+briefError (ValidationError _ _) = "validation failed"+briefError (ModuleNotFound _ _) = "not found"+briefError (MissingSourceFile _ _) = "missing source file"+briefError (CircularDependency _) = "circular dependency"+briefError (RegistryEvalError _ _) = "registry eval failed"++formatEntry :: Bool -> Int -> Int -> Entry -> Text+formatEntry color maxNameLen maxDescLen entry =+ let name = entry.entryName+ desc = entry.entryDesc+ src = entry.entrySource+ paddedName = name <> T.replicate (maxNameLen - T.length name + 3) " "+ paddedDesc = desc <> T.replicate (maxDescLen - T.length desc + 3) " "+ srcTag = "(" <> src <> ")"+ colorDesc = if color && entry.entryIsError then red desc else desc+ colorSrc = if color then dim srcTag else srcTag+ colorPaddedDesc = colorDesc <> T.replicate (maxDescLen - T.length desc + 3) " "+ in " " <> paddedName <> (if color && entry.entryIsError then colorPaddedDesc else paddedDesc) <> colorSrc
+ src/Seihou/CLI/Migrate.hs view
@@ -0,0 +1,808 @@+module Seihou.CLI.Migrate+ ( -- * Options+ MigrateOpts (..),++ -- * Handlers+ handleMigrate,+ runMigrate,+ MigrateError (..),+ MigrateResult (..),++ -- * Helpers for upgrade/status integration+ pendingChainFor,++ -- * Auto-commit helper+ commitMigratedFiles,+ )+where++import Control.Monad (unless, when)+import Data.Aeson (ToJSON, object, (.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString.Lazy.Char8 qualified as LBS+import Data.Maybe (isJust)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Data.Time.Clock (getCurrentTime)+import Effectful (runEff)+import GHC.Generics (Generic)+import Seihou.CLI.CommitMessage (generateCommitMessage)+import Seihou.CLI.Git (gitAdd, gitCheckIgnore, gitCommit, gitDiffCached, isGitRepo)+import Seihou.CLI.InstallShared+ ( OriginInfo (..),+ cloneRepo,+ installModuleDir,+ readOriginInfo,+ )+import Seihou.CLI.Style (bold, dim, green, red, useColor, yellow)+import Seihou.Core.Migration+ ( Migration (..),+ MigrationOp (..),+ MigrationPlan (..),+ MigrationPlanError (..),+ planMigrationChain,+ )+import Seihou.Core.Registry+ ( Registry (..),+ RegistryEntry (..),+ RepoContents (..),+ discoverRepoContents,+ )+import Seihou.Core.Types+ ( AppliedModule (..),+ Manifest (..),+ Module (..),+ ModuleName (..),+ )+import Seihou.Core.Version (Version, parseVersion, renderVersion)+import Seihou.Dhall.Eval (evalModuleFromFile, evalRegistryFromFile)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.ManifestStore (readManifest, writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Effect.ProcessInterp (runProcessIO)+import Seihou.Engine.Migrate+ ( ExecutedMigrationPlan (..),+ MigrationExecError (..),+ MigrationFileStatus (..),+ MigrationOpInstance (..),+ classifyMigration,+ executeMigration,+ )+import Seihou.Prelude+import System.Directory (doesFileExist)+import System.Exit (ExitCode (..), exitFailure, exitSuccess)+import System.FilePath (takeFileName, (</>))+import System.IO (stderr)+import System.IO.Temp (withSystemTempDirectory)++-- ----------------------------------------------------------------------------+-- Options+-- ----------------------------------------------------------------------------++-- | Options for @seihou migrate@: applies module-declared migrations to+-- the current project's working tree and manifest.+data MigrateOpts = MigrateOpts+ { migrateModule :: ModuleName,+ -- | Override the target version. Defaults to the installed+ -- module's current version (i.e. "migrate up to where the+ -- installed copy is now"). Under the gap-tolerant planner, the+ -- target is just the manifest's landing version: every declared+ -- migration whose @to@ does not exceed the target is applied,+ -- and the manifest advances to the target on success.+ migrateTo :: Maybe Text,+ migrateDryRun :: Bool,+ -- | Proceed even when the plan touches files the user has edited+ -- since they were generated. Mirrors @seihou remove --force@.+ migrateForce :: Bool,+ migrateJson :: Bool,+ migrateVerbose :: Bool,+ -- | Skip the default fetch-and-refresh step that clones the module's+ -- source repo and refreshes @~/.config/seihou/installed/<name>/@+ -- before planning the chain. When 'True', the command performs no+ -- network IO and uses only the locally installed copy as the source+ -- of truth. Default: 'False' (fetch is the new default after EP-2;+ -- before EP-2 the only behavior was local-only).+ migrateNoFetch :: Bool,+ -- | When 'True', and only on success branches that mutated the+ -- project's working tree, stage the touched files plus+ -- @.seihou/manifest.json@ and create a git commit. The commit+ -- message is supplied by 'migrateCommitMessage' if set, otherwise+ -- generated by 'Seihou.CLI.CommitMessage.generateCommitMessage'.+ -- Has no effect for dry-run or no-op outcomes. Has no effect+ -- outside a git work tree.+ migrateCommit :: Bool,+ -- | Custom commit message; implies @migrateCommit = True@.+ -- When 'Nothing', the AI-generated message is used.+ migrateCommitMessage :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++-- ----------------------------------------------------------------------------+-- Errors and results+-- ----------------------------------------------------------------------------++-- | Reasons the @seihou migrate@ handler exits non-zero. Each variant+-- carries a human-readable message that the IO shell prints and uses+-- as its error message.+data MigrateError+ = MigrateNoManifest FilePath+ | MigrateModuleNotApplied ModuleName+ | MigrateNoRecordedVersion ModuleName+ | MigrateInstalledModuleEvalFailed FilePath Text+ | MigrateInstalledModuleHasNoVersion ModuleName FilePath+ | MigrateUnparseableInstalledVersion Text+ | MigrateUnparseableTargetVersion Text+ | MigrateUnparseableManifestVersion Text+ | MigratePlanFailed MigrationPlanError+ | MigrateExecFailed MigrationExecError+ deriving stock (Eq, Show, Generic)++-- | Outcome of a successful @runMigrate@ call.+--+-- Three shapes only:+--+-- * 'MigrateNoOp' — the manifest already records the target version;+-- no work to do.+-- * 'MigrateApplied' — the manifest advanced from @from@ to @to@.+-- The carried 'ExecutedMigrationPlan' lists every step that+-- actually ran; it may be empty (a pure version bump where no+-- declared migration falls in the @[from, to]@ window).+-- * 'MigrateDryRunOK' — dry-run companion of 'MigrateApplied'.+data MigrateResult+ = MigrateNoOp Version+ | MigrateApplied ExecutedMigrationPlan Manifest Version Version+ | MigrateDryRunOK ExecutedMigrationPlan Version Version+ deriving stock (Eq, Show, Generic)++-- ----------------------------------------------------------------------------+-- IO shell+-- ----------------------------------------------------------------------------++-- | The IO entry point dispatched from @main@. Loads the manifest,+-- delegates planning + execution to 'runMigrate' (which handles the+-- fetch-and-refresh dance unless @--no-fetch@ was passed), and renders+-- the result.+handleMigrate :: MigrateOpts -> IO ()+handleMigrate opts = do+ let manifestPath = ".seihou" </> "manifest.json"+ modName = opts.migrateModule++ manifestRes <- runEff $ runFilesystem $ runManifestStore manifestPath readManifest+ manifest <- case manifestRes of+ Left err -> die (MigrateNoManifest (T.unpack err))+ Right Nothing -> die (MigrateNoManifest manifestPath)+ Right (Just m) -> pure m++ applied <- case findApplied manifest modName of+ Nothing -> die (MigrateModuleNotApplied modName)+ Just am -> pure am++ _fromV <- case applied.moduleVersion >>= parseVersion of+ Just v -> pure v+ Nothing -> case applied.moduleVersion of+ Nothing -> die (MigrateNoRecordedVersion modName)+ Just t -> die (MigrateUnparseableManifestVersion t)++ result <- runMigrate opts manifest applied.source++ colorEnabled <- useColor+ case result of+ Left err -> die err+ Right (MigrateNoOp toV) -> do+ TIO.putStrLn $+ applyColor colorEnabled green "✓"+ <> " "+ <> modName.unModuleName+ <> " is already at version "+ <> renderVersion toV+ <> "; nothing to do."+ exitSuccess+ Right (MigrateDryRunOK plan fromV toV) -> do+ if opts.migrateJson+ then LBS.putStr (encodePretty (planToJson plan))+ else do+ renderPlan colorEnabled plan fromV toV+ TIO.putStrLn ""+ TIO.putStrLn $ applyColor colorEnabled dim "(dry run — no changes made)"+ exitSuccess+ Right (MigrateApplied plan manifest' fromV toV) -> do+ if opts.migrateJson+ then LBS.putStr (encodePretty (planToJson plan))+ else renderPlan colorEnabled plan fromV toV+ runEff $+ runFilesystem $+ runManifestStore manifestPath $+ writeManifest manifest'+ when (opts.migrateCommit || isJust opts.migrateCommitMessage) $+ commitMigratedFiles opts manifestPath plan+ unless opts.migrateJson $ do+ TIO.putStrLn ""+ TIO.putStrLn $+ applyColor colorEnabled green "✓"+ <> " Migrated "+ <> applyColor colorEnabled bold modName.unModuleName+ <> " "+ <> renderVersion fromV+ <> " → "+ <> renderVersion toV+ <> "."++-- | The non-IO core of the handler. Useful as a building block for+-- other CLI surfaces (e.g. @seihou upgrade --with-migrations@) that+-- already have a manifest and an installed-module dir in hand.+--+-- Behavior depends on @opts.migrateNoFetch@:+--+-- * @True@ — operate purely on the supplied @installedDir@. This is+-- the legacy behavior used by @seihou upgrade --with-migrations@,+-- which has already refreshed the installed copy.+-- * @False@ (default) — read @<installedDir>\/.seihou-origin.json@,+-- clone the source repository shallowly, use the clone's module+-- dir as the source of truth for planning the chain, and on a+-- successful non-dry-run application refresh @installedDir@ from+-- the clone via 'installModuleDir'. Failures (missing origin file,+-- clone failure, module not present in remote) silently fall back+-- to the local-only path.+runMigrate ::+ MigrateOpts ->+ Manifest ->+ -- | Installed-module directory, the path that holds @module.dhall@+ FilePath ->+ IO (Either MigrateError MigrateResult)+runMigrate opts manifest installedDir+ | opts.migrateNoFetch = runMigrateLocal opts manifest installedDir+ | otherwise = runMigrateWithFetch opts manifest installedDir++-- | Plan and (optionally) execute a migration chain using @sourceDir@+-- as the source of truth for the module's @module.dhall@ and migrations+-- list. Performs no network IO.+runMigrateLocal ::+ MigrateOpts ->+ Manifest ->+ -- | Directory holding the module's @module.dhall@ — either the+ -- locally installed copy or a freshly cloned moduleDir.+ FilePath ->+ IO (Either MigrateError MigrateResult)+runMigrateLocal opts manifest sourceDir = do+ let modName = opts.migrateModule+ case findApplied manifest modName of+ Nothing -> pure (Left (MigrateModuleNotApplied modName))+ Just applied -> case applied.moduleVersion of+ Nothing -> pure (Left (MigrateNoRecordedVersion modName))+ Just fromText ->+ case parseVersion fromText of+ Nothing -> pure (Left (MigrateUnparseableManifestVersion fromText))+ Just fromV -> do+ let sourceDhall = sourceDir </> "module.dhall"+ exists <- doesFileExist sourceDhall+ if not exists+ then+ pure+ ( Left+ ( MigrateInstalledModuleEvalFailed+ sourceDhall+ "module.dhall not found at installed dir"+ )+ )+ else do+ r <- evalModuleFromFile sourceDhall+ case r of+ Left err ->+ pure+ ( Left+ ( MigrateInstalledModuleEvalFailed+ sourceDhall+ (T.pack (show err))+ )+ )+ Right sourceModule -> case resolveTarget opts sourceModule modName sourceDhall of+ Left e -> pure (Left e)+ Right toV ->+ case planMigrationChain+ modName.unModuleName+ sourceModule.migrations+ fromV+ toV of+ Left e -> pure (Left (MigratePlanFailed e))+ Right Nothing -> pure (Right (MigrateNoOp toV))+ Right (Just plan) ->+ dispatchPlan opts manifest plan++-- | The fetch-and-refresh wrapper. Reads @<installedDir>\/.seihou-origin.json@,+-- clones the source repo to a temp dir, locates the module within the+-- clone, and dispatches to 'runMigrateLocal' with the cloned module+-- dir. On a successful non-dry-run apply, refreshes @installedDir@+-- from the clone so the next @seihou status@/@migrate@ call sees the+-- new version locally.+--+-- Any soft failure in the fetch path (missing origin metadata, clone+-- failure, module not in remote) emits a one-line note (unless JSON+-- output is requested, in which case the path stays silent so JSON+-- consumers aren't disturbed) and falls back to 'runMigrateLocal'+-- against the original 'installedDir'.+runMigrateWithFetch ::+ MigrateOpts ->+ Manifest ->+ FilePath ->+ IO (Either MigrateError MigrateResult)+runMigrateWithFetch opts manifest installedDir = do+ origin <- readOriginInfo installedDir+ case origin of+ Nothing -> do+ note opts $+ " no origin metadata at "+ <> T.pack (installedDir </> ".seihou-origin.json")+ <> "; using locally installed copy."+ runMigrateLocal opts manifest installedDir+ Just o -> withSystemTempDirectory "seihou-migrate-fetch" $ \tmp -> do+ let cloneDir = tmp </> "clone"+ note opts (" Fetching " <> o.sourceUrl <> "...")+ cloneRes <- cloneRepo o.sourceUrl cloneDir+ case cloneRes of+ Left err -> do+ note opts (" fetch failed: " <> err <> "; using locally installed copy.")+ runMigrateLocal opts manifest installedDir+ Right () -> do+ contents <- discoverRepoContents evalRegistryFromFile cloneDir+ case findRemoteModuleDir cloneDir contents opts.migrateModule of+ Nothing -> do+ note opts $+ " module '"+ <> opts.migrateModule.unModuleName+ <> "' not present in remote; using locally installed copy."+ runMigrateLocal opts manifest installedDir+ Just (moduleDir, tags) -> do+ -- Plan and execute against the clone's module dir. The+ -- chain operates on the project's working tree; the+ -- moduleDir only supplies the migrations list and the+ -- target version.+ cloneResult <- runMigrateLocal opts manifest moduleDir+ -- EP-27 / EP-35 M5: when the local install declares more+ -- in-window migrations than the clone, prefer the local+ -- plan. The user's installed copy may still declare an+ -- applicable edge that the remote dropped; honour it+ -- rather than silently skip.+ result <- maybeFallbackToLocal opts manifest installedDir cloneResult+ -- Refresh the installed copy on the disk so future+ -- commands see the new version locally. Any successful+ -- apply (with or without ops) updates the disk; dry-run+ -- and no-op outcomes leave it untouched.+ case result of+ Right (MigrateApplied {})+ | not opts.migrateDryRun ->+ refreshInstalledFromClone moduleDir installedDir o tags+ _ -> pure ()+ pure result++-- | If the local install yields a plan with strictly more in-window+-- migrations than the clone-based plan, prefer the local result.+-- Otherwise the clone's plan stands. The check fires on any successful+-- result (Applied, DryRunOK, NoOp); errors are passed through+-- unchanged.+maybeFallbackToLocal ::+ MigrateOpts ->+ Manifest ->+ FilePath ->+ Either MigrateError MigrateResult ->+ IO (Either MigrateError MigrateResult)+maybeFallbackToLocal opts manifest installedDir cloneResult = case cloneResult of+ Left _ -> pure cloneResult+ Right cloneOk -> do+ localResult <- runMigrateLocal opts manifest installedDir+ pure $ case localResult of+ Right localOk+ | resultStepCount localOk > resultStepCount cloneOk -> localResult+ _ -> cloneResult++-- | Number of migration steps a result actually carries (or would+-- carry, in dry-run form). Used by 'maybeFallbackToLocal'.+resultStepCount :: MigrateResult -> Int+resultStepCount = \case+ MigrateNoOp {} -> 0+ MigrateApplied execPlan _ _ _ -> length execPlan.planSource.planSteps+ MigrateDryRunOK execPlan _ _ -> length execPlan.planSource.planSteps++-- | Print a one-line note unless JSON output is requested. Using JSON+-- output requires a clean, parseable stdout.+note :: MigrateOpts -> Text -> IO ()+note opts msg = unless opts.migrateJson (TIO.putStrLn msg)++-- | Locate the module's directory inside a cloned repo and return any+-- registry-declared tags. Returns 'Nothing' for empty repos or+-- recipe-only repos, or for multi-module repos that do not list the+-- requested module.+findRemoteModuleDir ::+ FilePath ->+ RepoContents ->+ ModuleName ->+ Maybe (FilePath, [Text])+findRemoteModuleDir cloneDir contents modName = case contents of+ SingleModule rootDir -> Just (rootDir, [])+ MultiModule registry ->+ case filter (\e -> e.name == modName) registry.modules of+ (entry : _) -> Just (cloneDir </> entry.path, entry.tags)+ [] -> Nothing+ SingleRecipe _ -> Nothing+ SingleBlueprint _ -> Nothing+ SinglePrompt _ -> Nothing+ EmptyRepo -> Nothing++-- | Refresh the on-disk installed module directory from a cloned+-- module dir. Reads the clone's @module.dhall@ for its declared+-- version, then calls 'installModuleDir' with the same name as the+-- existing installation (basename of @installedDir@) so the XDG-derived+-- destination matches the original install path.+refreshInstalledFromClone ::+ FilePath ->+ FilePath ->+ OriginInfo ->+ [Text] ->+ IO ()+refreshInstalledFromClone moduleDir installedDir origin tags = do+ let dhallFile = moduleDir </> "module.dhall"+ modulRes <- evalModuleFromFile dhallFile+ case modulRes of+ Left _ -> pure ()+ Right modul -> do+ let installedName = takeFileName installedDir+ installModuleDir+ moduleDir+ installedName+ origin.sourceUrl+ origin.repoName+ modul.version+ tags++-- ----------------------------------------------------------------------------+-- Pending-migration detection (used by status / upgrade)+-- ----------------------------------------------------------------------------++-- | Detect whether the manifest's recorded version of an applied module+-- has fallen behind the installed copy. Returns:+--+-- * @Nothing@ — versions equal, manifest version unrecorded,+-- installed-module version unrecorded, parse failure anywhere, or+-- the planner reported a hard error.+-- * @Just plan@ — a non-trivial plan whose 'planSteps' may be empty+-- (a pure version bump) or non-empty.+--+-- Parse failures and planner errors are treated as "no pending+-- migration" rather than surfaced — this is the soft-warning path for+-- @seihou status@. Hard errors land on the user when they actually+-- run @seihou migrate@.+pendingChainFor ::+ AppliedModule ->+ Module ->+ Maybe MigrationPlan+pendingChainFor applied installed = do+ fromText <- applied.moduleVersion+ fromV <- parseVersion fromText+ toText <- installed.version+ toV <- parseVersion toText+ case planMigrationChain+ applied.name.unModuleName+ installed.migrations+ fromV+ toV of+ Right (Just plan) -> Just plan+ _ -> Nothing++-- ----------------------------------------------------------------------------+-- Helpers+-- ----------------------------------------------------------------------------++-- | Decide what to do with a 'MigrationPlan' returned by the planner.+-- Pure-IO: classifies the plan, optionally executes it, and packs the+-- outcome into a 'MigrateResult' variant the renderer knows how to+-- print.+--+-- The plan from the gap-tolerant walker is always one shape — an+-- ordered list of in-window migrations plus the supplied @planFrom@+-- and @planTo@. The dispatcher branches only on @planFrom == planTo@+-- (no work) and dry-run vs apply.+dispatchPlan ::+ MigrateOpts ->+ Manifest ->+ MigrationPlan ->+ IO (Either MigrateError MigrateResult)+dispatchPlan opts manifest plan+ | plan.planFrom == plan.planTo = pure (Right (MigrateNoOp plan.planTo))+ | otherwise = applyOrDryRun opts manifest plan++-- | Classify the plan, optionally execute it, and return the+-- appropriate 'MigrateResult' variant. Empty 'planSteps' is fine —+-- 'executeMigration' runs zero file ops but still advances the+-- manifest's recorded @moduleVersion@ to @planTo@.+applyOrDryRun ::+ MigrateOpts ->+ Manifest ->+ MigrationPlan ->+ IO (Either MigrateError MigrateResult)+applyOrDryRun opts manifest plan = do+ classifyResult <-+ runEff $+ runFilesystem $+ classifyMigration manifest plan+ case classifyResult of+ Left err -> pure (Left (MigrateExecFailed err))+ Right executedPlan ->+ if opts.migrateDryRun+ then pure (Right (MigrateDryRunOK executedPlan plan.planFrom plan.planTo))+ else do+ now <- getCurrentTime+ execRes <-+ runEff $+ runFilesystem $+ runProcessIO $+ executeMigration opts.migrateForce executedPlan manifest now+ case execRes of+ Left err -> pure (Left (MigrateExecFailed err))+ Right manifest' ->+ pure (Right (MigrateApplied executedPlan manifest' plan.planFrom plan.planTo))++-- | Stage and commit the files touched by a successful migration plan.+-- Mirrors the @seihou run --commit@ post-execution helper. No-op+-- outside a git work tree, when every staged path is git-ignored, or+-- when both flags are off (callers gate on the flags before invoking+-- this). 'RunCommandInst' ops contribute no paths — their filesystem+-- effects are opaque, so any extra working-tree changes need a+-- separate manual commit.+commitMigratedFiles ::+ MigrateOpts ->+ -- | Manifest path (added to the staged set).+ FilePath ->+ ExecutedMigrationPlan ->+ IO ()+commitMigratedFiles opts manifestPath plan = do+ let touched = concatMap pathsForOp plan.planOps+ filesToStage = touched ++ [manifestPath]+ inGit <- runEff $ runProcessIO isGitRepo+ when inGit $ do+ ignored <- runEff $ runProcessIO $ gitCheckIgnore filesToStage+ let staged = filter (`notElem` ignored) filesToStage+ unless (null staged) $ do+ (addExit, _, addErr) <- runEff $ runProcessIO $ gitAdd staged+ case addExit of+ ExitFailure _ -> TIO.hPutStrLn stderr ("git add failed: " <> addErr)+ ExitSuccess -> do+ msg <- case opts.migrateCommitMessage of+ Just m -> pure m+ Nothing -> do+ diffText <- runEff $ runProcessIO gitDiffCached+ generateCommitMessage [opts.migrateModule] diffText+ (cExit, _, cErr) <- runEff $ runProcessIO $ gitCommit msg+ case cExit of+ ExitSuccess -> pure ()+ ExitFailure _ ->+ TIO.hPutStrLn stderr ("git commit failed: " <> cErr)+ where+ pathsForOp inst = case inst of+ MoveFileInst src dest _ -> [src, dest]+ MoveDirInst src dest -> [src, dest]+ DeleteFileInst path _ -> [path]+ DeleteDirInst path -> [path]+ RunCommandInst _ _ -> []++resolveTarget ::+ MigrateOpts -> Module -> ModuleName -> FilePath -> Either MigrateError Version+resolveTarget opts installedModule modName installedDhall =+ case opts.migrateTo of+ Just t -> case parseVersion t of+ Just v -> Right v+ Nothing -> Left (MigrateUnparseableTargetVersion t)+ Nothing -> case installedModule.version of+ Nothing -> Left (MigrateInstalledModuleHasNoVersion modName installedDhall)+ Just t -> case parseVersion t of+ Just v -> Right v+ Nothing -> Left (MigrateUnparseableInstalledVersion t)++findApplied :: Manifest -> ModuleName -> Maybe AppliedModule+findApplied m name =+ case filter (\am -> am.name == name) m.modules of+ (am : _) -> Just am+ [] -> Nothing++-- | Render a classified plan to stdout in the human-readable format.+-- The supplied versions are the user-visible "X → Y" header taken from+-- the source plan's @planFrom@ and @planTo@; the manifest will land at+-- @planTo@ even when 'planSteps' is empty.+renderPlan :: Bool -> ExecutedMigrationPlan -> Version -> Version -> IO ()+renderPlan c plan fromV toV = do+ let src = plan.planSource+ TIO.putStrLn $+ "Migration plan: "+ <> applyColor c bold (src.planModule)+ <> " "+ <> renderVersion fromV+ <> " → "+ <> renderVersion toV+ if null src.planSteps+ then TIO.putStrLn " (no migration ops)"+ else mapM_ (renderStep c) src.planSteps+ let conflictCount =+ length+ [ () | inst <- plan.planOps, isConflict inst+ ]+ affectedCount =+ length+ [ () | inst <- plan.planOps, touchesFs inst+ ]+ TIO.putStrLn ""+ TIO.putStrLn $+ T.pack (show affectedCount)+ <> " operation(s), "+ <> T.pack (show conflictCount)+ <> " conflict(s)."+ where+ isConflict (MoveFileInst _ _ MFConflict) = True+ isConflict (DeleteFileInst _ MFConflict) = True+ isConflict _ = False++ touchesFs (RunCommandInst _ _) = True+ touchesFs _ = True++renderStep :: Bool -> Migration -> IO ()+renderStep c step = do+ TIO.putStrLn $ " " <> step.from <> " → " <> step.to <> ":"+ mapM_ (renderOp c) step.ops++renderOp :: Bool -> MigrationOp -> IO ()+renderOp c op = case op of+ MoveFile {src, dest} ->+ TIO.putStrLn $ " " <> applyColor c green "move-file " <> T.pack src <> " -> " <> T.pack dest+ MoveDir {src, dest} ->+ TIO.putStrLn $ " " <> applyColor c green "move-dir " <> T.pack src <> " -> " <> T.pack dest+ DeleteFile {path} ->+ TIO.putStrLn $ " " <> applyColor c yellow "delete " <> T.pack path+ DeleteDir {path} ->+ TIO.putStrLn $ " " <> applyColor c yellow "delete-dir" <> " " <> T.pack path+ RunCommand {run, workDir} ->+ let suffix = case workDir of+ Just wd -> applyColor c dim (" (in " <> T.pack wd <> ")")+ Nothing -> ""+ in TIO.putStrLn $ " " <> applyColor c green "run " <> run <> suffix++-- ----------------------------------------------------------------------------+-- JSON output+-- ----------------------------------------------------------------------------++planToJson :: ExecutedMigrationPlan -> Aeson.Value+planToJson plan =+ let src = plan.planSource+ in object+ [ "module" .= plan.planModule.unModuleName,+ "from" .= renderVersion src.planFrom,+ "to" .= renderVersion src.planTo,+ "steps"+ .= [ object+ [ "from" .= step.from,+ "to" .= step.to,+ "ops" .= map opToJson step.ops+ ]+ | step <- src.planSteps+ ],+ "operations" .= map instToJson plan.planOps+ ]++opToJson :: MigrationOp -> Aeson.Value+opToJson op = case op of+ MoveFile {src, dest} ->+ object ["op" .= ("move-file" :: Text), "src" .= T.pack src, "dest" .= T.pack dest]+ MoveDir {src, dest} ->+ object ["op" .= ("move-dir" :: Text), "src" .= T.pack src, "dest" .= T.pack dest]+ DeleteFile {path} ->+ object ["op" .= ("delete-file" :: Text), "path" .= T.pack path]+ DeleteDir {path} ->+ object ["op" .= ("delete-dir" :: Text), "path" .= T.pack path]+ RunCommand {run, workDir} ->+ object ["op" .= ("run-command" :: Text), "run" .= run, "workDir" .= fmap T.pack workDir]++instToJson :: MigrationOpInstance -> Aeson.Value+instToJson inst = case inst of+ MoveFileInst src dest status ->+ object+ [ "op" .= ("move-file" :: Text),+ "src" .= T.pack src,+ "dest" .= T.pack dest,+ "status" .= statusToJson status+ ]+ MoveDirInst src dest ->+ object+ ["op" .= ("move-dir" :: Text), "src" .= T.pack src, "dest" .= T.pack dest]+ DeleteFileInst p status ->+ object+ [ "op" .= ("delete-file" :: Text),+ "path" .= T.pack p,+ "status" .= statusToJson status+ ]+ DeleteDirInst p ->+ object ["op" .= ("delete-dir" :: Text), "path" .= T.pack p]+ RunCommandInst run wd ->+ object ["op" .= ("run-command" :: Text), "run" .= run, "workDir" .= fmap T.pack wd]++statusToJson :: MigrationFileStatus -> Text+statusToJson MFSafe = "safe"+statusToJson MFConflict = "conflict"+statusToJson MFGone = "gone"++-- ----------------------------------------------------------------------------+-- Misc+-- ----------------------------------------------------------------------------++-- | Apply ANSI styling when colour is enabled.+applyColor :: Bool -> (Text -> Text) -> Text -> Text+applyColor True f = f+applyColor False _ = id++-- | Print the error and exit non-zero. The IO shell calls this; the+-- pure 'runMigrate' returns 'Left' instead.+die :: MigrateError -> IO a+die err = do+ c <- useColor+ TIO.putStrLn $ applyColor c red "Error: " <> renderError err+ exitFailure++renderError :: MigrateError -> Text+renderError (MigrateNoManifest path) =+ "no Seihou manifest at " <> T.pack path <> "; run from a project that has been initialized."+renderError (MigrateModuleNotApplied modName) =+ "module '" <> modName.unModuleName <> "' is not applied in this project."+renderError (MigrateNoRecordedVersion modName) =+ "module '"+ <> modName.unModuleName+ <> "' has no version recorded in the manifest. Re-apply the module with 'seihou run' to record one before migrating."+renderError (MigrateInstalledModuleEvalFailed path msg) =+ "could not evaluate installed module at " <> T.pack path <> ": " <> msg+renderError (MigrateInstalledModuleHasNoVersion modName path) =+ "installed module '"+ <> modName.unModuleName+ <> "' at "+ <> T.pack path+ <> " has no version field; either pass --to or add a version to its module.dhall."+renderError (MigrateUnparseableInstalledVersion v) =+ "installed module's version '" <> v <> "' is not a valid dotted version."+renderError (MigrateUnparseableTargetVersion v) =+ "--to value '" <> v <> "' is not a valid dotted version."+renderError (MigrateUnparseableManifestVersion v) =+ "manifest's recorded module version '" <> v <> "' is not a valid dotted version."+renderError (MigratePlanFailed e) = renderPlanError e+renderError (MigrateExecFailed e) = renderExecError e++renderPlanError :: MigrationPlanError -> Text+renderPlanError (MigrationVersionUnparseable t) =+ "a migration declares an unparseable version: '" <> t <> "'"+renderPlanError (MigrationDowngradeNotSupported installed target) =+ "downgrade not supported: installed "+ <> renderVersion installed+ <> ", requested target "+ <> renderVersion target+ <> "."+renderPlanError (MigrationDuplicateEdge fromV _) =+ "two or more migrations declare the same 'from = "+ <> renderVersion fromV+ <> "'. The chain is ambiguous; the module author needs to merge or remove the duplicate."++renderExecError :: MigrationExecError -> Text+renderExecError (MigrationConflict paths) =+ "the following file(s) have been modified since they were generated:\n"+ <> T.intercalate "\n" [" - " <> T.pack p | p <- paths]+ <> "\n\nRe-run with --force to overwrite them, or revert your edits first."+renderExecError (MigrationCommandFailed msg code) =+ "a run-command op exited with code "+ <> T.pack (show code)+ <> ":\n "+ <> msg+renderExecError (MigrationUnsafePath label path reason) =+ "unsafe migration "+ <> label+ <> " '"+ <> T.pack path+ <> "': "+ <> reason++-- Aeson ToJSON pass-through for ExecutedMigrationPlan: routed through+-- planToJson manually rather than deriving so we have the field shape+-- documented above.+instance ToJSON ExecutedMigrationPlan where+ toJSON = planToJson
+ src/Seihou/CLI/PendingMigrations.hs view
@@ -0,0 +1,86 @@+module Seihou.CLI.PendingMigrations+ ( detectPendingMigrations,+ formatRefusalMessage,+ )+where++import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.CLI.Migrate (pendingChainFor)+import Seihou.Core.Migration (MigrationPlan (..))+import Seihou.Core.Types+ ( AppliedModule (..),+ Manifest (..),+ ModuleName (..),+ )+import Seihou.Core.Version (renderVersion)+import Seihou.Dhall.Eval (evalModuleFromFile)+import Seihou.Prelude+import System.Directory (doesFileExist)++-- | Detect pending migrations across applied modules in a manifest.+--+-- For each applied module whose installed @module.dhall@ declares a+-- newer version than the manifest's recorded version, return the+-- migration plan that describes the gap. Under the gap-tolerant+-- planner the plan always advances the manifest to the supplied+-- target on apply; the carried 'planSteps' may be empty (a pure+-- version bump where no declared migration falls in the window) or+-- non-empty.+--+-- IO failures (missing @module.dhall@, eval errors, parse failures) are+-- silently skipped: pending-migration reporting is best-effort and never+-- raises.+--+-- The optional filter restricts detection to a subset of module names.+-- 'Nothing' means "consider every applied module" (used by @seihou+-- status@). @'Just' names@ keeps only modules whose name is in the set+-- (used by @seihou run@, which only blocks when a module it is about+-- to write into has a pending plan).+detectPendingMigrations ::+ Manifest ->+ Maybe (Set ModuleName) ->+ IO [(ModuleName, MigrationPlan)]+detectPendingMigrations manifest mFilter =+ fmap+ (\xs -> [(name, p) | (name, Just p) <- xs])+ (mapM check candidates)+ where+ candidates = case mFilter of+ Nothing -> manifest.modules+ Just names -> filter (\am -> Set.member am.name names) manifest.modules++ check am = do+ let dhallFile = am.source </> "module.dhall"+ exists <- doesFileExist dhallFile+ if not exists+ then pure (am.name, Nothing)+ else do+ r <- evalModuleFromFile dhallFile+ case r of+ Left _ -> pure (am.name, Nothing)+ Right installed -> pure (am.name, pendingChainFor am installed)++-- | Format the user-facing refusal message that @seihou run@ prints+-- when it detects pending migrations and the user has not opted into+-- @--with-migrations@. Each row reports the module, the version range+-- the migration would cover, and how many migration ops it would run+-- (which may be zero — a pure version bump).+formatRefusalMessage :: [(ModuleName, MigrationPlan)] -> Text+formatRefusalMessage pendings =+ T.unlines $+ "Pending migrations detected:"+ : map renderEntry pendings+ ++ ["", "Run 'seihou migrate <module>' for each, or pass --with-migrations to apply during this run."]+ where+ renderEntry (name, plan) =+ " "+ <> name.unModuleName+ <> ": "+ <> renderVersion plan.planFrom+ <> " -> "+ <> renderVersion plan.planTo+ <> " ("+ <> T.pack (show (length plan.planSteps))+ <> " step(s))"
+ src/Seihou/CLI/PromptRender.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE TemplateHaskell #-}++module Seihou.CLI.PromptRender+ ( renderPromptSystemPrompt,+ renderPromptBody,+ formatPromptGuidance,+ )+where++import Data.FileEmbed (embedFile)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Seihou.CLI.AgentLaunch+ ( AgentContext (..),+ formatAvailableModules,+ formatLocalModules,+ formatManifestState,+ formatModuleDhallState,+ formatReferenceFiles,+ formatSeihouProjectState,+ substitute,+ )+import Seihou.Core.Expr (evalExpr)+import Seihou.Core.Types++promptRunTemplate :: T.Text+promptRunTemplate = TE.decodeUtf8 $(embedFile "data/prompt-run-prompt.md")++renderPromptSystemPrompt ::+ AgentContext ->+ AgentPrompt ->+ Map VarName ResolvedVar ->+ T.Text ->+ Maybe T.Text ->+ T.Text+renderPromptSystemPrompt ctx prompt resolved renderedPrompt userPrompt =+ substitute+ [ ("cwd", ctx.cwd),+ ("seihou_project_state", formatSeihouProjectState ctx),+ ("manifest_state", formatManifestState ctx),+ ("module_dhall_state", formatModuleDhallState ctx),+ ("local_modules", formatLocalModules ctx),+ ("available_modules", formatAvailableModules ctx),+ ("prompt_name", prompt.name.unModuleName),+ ("prompt_version", fromMaybe "(unspecified)" prompt.version),+ ("prompt_description", fromMaybe "(no description)" prompt.description),+ ("reference_files", formatReferenceFiles prompt.files),+ ("prompt_guidance", formatPromptGuidance resolved prompt.guidance),+ ("prompt_body", renderedPrompt),+ ("user_prompt", fromMaybe "(no one-off user instruction)" userPrompt)+ ]+ promptRunTemplate++renderPromptBody :: Map VarName ResolvedVar -> T.Text -> T.Text+renderPromptBody resolved tpl =+ substitute+ [(vn.unVarName, varValueToText rv.value) | (vn, rv) <- Map.toList resolved]+ tpl++formatPromptGuidance :: Map VarName ResolvedVar -> [PromptGuidance] -> T.Text+formatPromptGuidance resolved guidance =+ case filter selected guidance of+ [] -> "(no prompt guidance)"+ selectedGuidance -> T.intercalate "\n\n" (map render selectedGuidance)+ where+ bindings = Map.map (.value) resolved++ selected g =+ case g.condition of+ Nothing -> True+ Just cond -> evalExpr bindings cond++ render g =+ T.unlines+ [ "### " <> g.title,+ "",+ g.body+ ]++varValueToText :: VarValue -> T.Text+varValueToText (VText t) = t+varValueToText (VBool True) = "true"+varValueToText (VBool False) = "false"+varValueToText (VInt n) = T.pack (show n)+varValueToText (VList vs) = T.intercalate "," (map varValueToText vs)
+ src/Seihou/CLI/Registry.hs view
@@ -0,0 +1,22 @@+module Seihou.CLI.Registry+ ( RegistryCommand (..),+ handleRegistry,+ )+where++import GHC.Generics (Generic)+import Seihou.CLI.Registry.Sync (SyncVersionsOpts, handleSyncVersions)+import Seihou.CLI.Registry.Validate (ValidateRegistryOpts, handleValidate)++-- | Subcommand selector for the @seihou registry@ group. Reserves space for+-- future operations (e.g. @registry add@, @registry publish@) without+-- another CLI restructuring pass.+data RegistryCommand+ = RegistrySyncVersions SyncVersionsOpts+ | RegistryValidate ValidateRegistryOpts+ deriving stock (Eq, Show, Generic)++-- | Dispatch the selected @registry@ subcommand to its handler.+handleRegistry :: RegistryCommand -> IO ()+handleRegistry (RegistrySyncVersions opts) = handleSyncVersions opts+handleRegistry (RegistryValidate opts) = handleValidate opts
+ src/Seihou/CLI/Registry/Sync.hs view
@@ -0,0 +1,287 @@+module Seihou.CLI.Registry.Sync+ ( SyncVersionsOpts (..),+ SyncAction (..),+ SyncOutcome (..),+ runSync,+ handleSyncVersions,+ renderSyncReport,+ checkRegistryVersionDrift,+ resolveOnDiskVersions,+ )+where++import Data.Maybe (mapMaybe)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import GHC.Generics (Generic)+import Seihou.Core.Registry+ ( EntryKind (..),+ Registry (..),+ RegistryEntry (..),+ RepoContents (..),+ SyncDiff (..),+ SyncReport (..),+ SyncStatus (..),+ computeRegistrySync,+ discoverRepoContents,+ formatDriftWarning,+ renderRegistryDhall,+ )+import Seihou.Core.Types (AgentPrompt, Blueprint, Module, ModuleName (..), Recipe)+import Seihou.Core.Types qualified as Types+import Seihou.Dhall.Eval+ ( evalAgentPromptFromFile,+ evalBlueprintFromFile,+ evalModuleFromFile,+ evalRecipeFromFile,+ evalRegistryFromFile,+ )+import Seihou.Prelude+import System.Directory (doesDirectoryExist)+import System.Exit (ExitCode (..), exitWith)+import System.FilePath ((</>))+import System.IO (hPutStrLn, stderr)++-- | Flags parsed for the @seihou registry sync-versions@ subcommand.+data SyncVersionsOpts = SyncVersionsOpts+ { syncVersionsDir :: Maybe FilePath,+ syncVersionsDryRun :: Bool,+ syncVersionsCheck :: Bool+ }+ deriving stock (Eq, Show, Generic)++-- | What the sync pass did with the registry file.+data SyncAction+ = -- | Registry file rewritten on disk.+ Wrote+ | -- | @--dry-run@: diff computed, file left untouched.+ WouldWrite+ | -- | @--check@: diff computed, file left untouched, exit code reflects drift.+ Checked+ deriving stock (Eq, Show, Generic)++-- | Terminal outcome of a sync run, decoupled from IO concerns like printing+-- and 'exitWith' so tests can assert without capturing stdout.+data SyncOutcome+ = -- | Registry loaded, diff computed, action applied.+ SyncSuccess SyncReport SyncAction+ | -- | Target invalid (directory missing, no registry file, etc.); carries a+ -- human-readable error.+ SyncFailure Text+ deriving stock (Eq, Show, Generic)++-- | Testable core of @seihou registry sync-versions@. Locates the registry,+-- reads each entry's on-disk version, computes the diff, writes the file+-- when appropriate, and returns a structured outcome.+runSync :: SyncVersionsOpts -> IO SyncOutcome+runSync opts = do+ let targetDir = maybe "." id opts.syncVersionsDir+ dirExists <- doesDirectoryExist targetDir+ if not dirExists+ then pure (SyncFailure ("target directory does not exist: " <> T.pack targetDir))+ else do+ contents <- discoverRepoContents evalRegistryFromFile targetDir+ case contents of+ MultiModule reg -> do+ lookups <- resolveOnDiskVersions targetDir reg+ let report = computeRegistrySync reg lookups+ let checkMode = opts.syncVersionsCheck+ dryRun = opts.syncVersionsDryRun && not checkMode+ writeMode = not checkMode && not dryRun+ action <-+ if writeMode+ then do+ let rendered = renderRegistryDhall report.syncUpdated+ TIO.writeFile (targetDir </> "seihou-registry.dhall") rendered+ pure Wrote+ else+ if checkMode+ then pure Checked+ else pure WouldWrite+ pure (SyncSuccess report action)+ _ ->+ pure+ ( SyncFailure+ "registry sync-versions requires a seihou-registry.dhall at the target directory"+ )++-- | Read each registry entry's runnable Dhall file and pair it with the+-- entry's @(kind, name)@. Entries whose file fails to evaluate are omitted+-- from the returned list, which causes 'computeRegistrySync' to classify them+-- as 'SyncOrphan'.+resolveOnDiskVersions ::+ FilePath ->+ Registry ->+ IO [(EntryKind, ModuleName, Maybe Text)]+resolveOnDiskVersions repoRoot reg = do+ modulePairs <- mapM (loadModule repoRoot) reg.modules+ recipePairs <- mapM (loadRecipe repoRoot) reg.recipes+ blueprintPairs <- mapM (loadBlueprint repoRoot) reg.blueprints+ promptPairs <- mapM (loadPrompt repoRoot) reg.prompts+ pure (concat modulePairs <> concat recipePairs <> concat blueprintPairs <> concat promptPairs)+ where+ loadModule :: FilePath -> RegistryEntry -> IO [(EntryKind, ModuleName, Maybe Text)]+ loadModule root entry = do+ let path = root </> entry.path </> "module.dhall"+ decoded <- evalModuleFromFile path+ case decoded of+ Right m -> pure [(ModuleEntry, entry.name, moduleVersion m)]+ Left _ -> pure []+ loadRecipe :: FilePath -> RegistryEntry -> IO [(EntryKind, ModuleName, Maybe Text)]+ loadRecipe root entry = do+ let path = root </> entry.path </> "recipe.dhall"+ decoded <- evalRecipeFromFile path+ case decoded of+ Right r -> pure [(RecipeEntry, entry.name, recipeVersion r)]+ Left _ -> pure []+ loadBlueprint :: FilePath -> RegistryEntry -> IO [(EntryKind, ModuleName, Maybe Text)]+ loadBlueprint root entry = do+ let path = root </> entry.path </> "blueprint.dhall"+ decoded <- evalBlueprintFromFile path+ case decoded of+ Right b -> pure [(BlueprintEntry, entry.name, blueprintVersion b)]+ Left _ -> pure []+ loadPrompt :: FilePath -> RegistryEntry -> IO [(EntryKind, ModuleName, Maybe Text)]+ loadPrompt root entry = do+ let path = root </> entry.path </> "prompt.dhall"+ decoded <- evalAgentPromptFromFile path+ case decoded of+ Right p -> pure [(PromptEntry, entry.name, promptVersion p)]+ Left _ -> pure []++-- | Extract the @version@ field from a 'Module' by pattern match. A direct+-- record-dot access (@m.version@) fails under 'DuplicateRecordFields' ++-- 'NoFieldSelectors' in this module because 'RegistryEntry' and 'Module'+-- share the field name.+moduleVersion :: Module -> Maybe Text+moduleVersion Types.Module {Types.version = v} = v++-- | Analogous accessor for 'Recipe.version'. See 'moduleVersion'.+recipeVersion :: Recipe -> Maybe Text+recipeVersion Types.Recipe {Types.version = v} = v++-- | Analogous accessor for 'Blueprint.version'. See 'moduleVersion'.+blueprintVersion :: Blueprint -> Maybe Text+blueprintVersion Types.Blueprint {Types.version = v} = v++-- | Analogous accessor for 'AgentPrompt.version'. See 'moduleVersion'.+promptVersion :: AgentPrompt -> Maybe Text+promptVersion Types.AgentPrompt {Types.version = v} = v++-- | Handler wired into the CLI command dispatcher. Drives 'runSync', prints a+-- human-readable diff, and exits with 0 or 1 as appropriate.+handleSyncVersions :: SyncVersionsOpts -> IO ()+handleSyncVersions opts = do+ outcome <- runSync opts+ case outcome of+ SyncFailure msg -> do+ hPutStrLn stderr ("error: " <> T.unpack msg)+ exitWith (ExitFailure 1)+ SyncSuccess report action -> do+ TIO.putStr (renderSyncReport report)+ case action of+ Wrote -> exitWith ExitSuccess+ WouldWrite -> exitWith ExitSuccess+ Checked ->+ if anyDrift report+ then exitWith (ExitFailure 1)+ else exitWith ExitSuccess++-- | Format the diff table and summary line for display on stdout.+-- The first entry in 'syncDiffs' appears first, preserving registry order.+renderSyncReport :: SyncReport -> Text+renderSyncReport report+ | null report.syncDiffs =+ "Registry is empty.\n"+ | otherwise =+ T.unlines $+ header+ : map (" " <>) rows+ <> ["", summary report]+ where+ header = "Updated seihou-registry.dhall:"+ rows = map renderRow report.syncDiffs++ renderRow :: SyncDiff -> Text+ renderRow diff =+ let label = kindPrefix diff.diffKind <> diff.diffName.unModuleName <> ":"+ padded = padRight labelWidth label+ old = renderVersion diff.diffOld+ new = renderVersion diff.diffNew+ arrow = case diff.diffStatus of+ SyncInSync -> " == " <> new <> " (no change)"+ SyncOrphan -> " ?? " <> old <> " (" <> entryFile diff.diffKind <> " missing)"+ _ -> " -> " <> new+ in padded <> old <> arrow++ labelWidth = maximum (24 : map diffLabelWidth report.syncDiffs)+ diffLabelWidth d =+ T.length (kindPrefix d.diffKind <> d.diffName.unModuleName) + 2++kindPrefix :: EntryKind -> Text+kindPrefix ModuleEntry = "modules."+kindPrefix RecipeEntry = "recipes."+kindPrefix BlueprintEntry = "blueprints."+kindPrefix PromptEntry = "prompts."++entryFile :: EntryKind -> Text+entryFile ModuleEntry = "module.dhall"+entryFile RecipeEntry = "recipe.dhall"+entryFile BlueprintEntry = "blueprint.dhall"+entryFile PromptEntry = "prompt.dhall"++renderVersion :: Maybe Text -> Text+renderVersion Nothing = "(none)"+renderVersion (Just v) = v++padRight :: Int -> Text -> Text+padRight w t =+ let pad = max 0 (w - T.length t)+ in t <> T.replicate pad " "++summary :: SyncReport -> Text+summary report =+ let updated = length [d | d <- report.syncDiffs, changesVersion d.diffStatus]+ orphans = length [d | d <- report.syncDiffs, d.diffStatus == SyncOrphan]+ unchanged = length [d | d <- report.syncDiffs, d.diffStatus == SyncInSync]+ base =+ T.pack (show updated)+ <> " "+ <> pluralize updated "entry" "entries"+ <> " updated, "+ <> T.pack (show unchanged)+ <> " unchanged"+ suffix =+ if orphans > 0+ then ", " <> T.pack (show orphans) <> " orphan" <> (if orphans > 1 then "s" else "")+ else ""+ in base <> suffix <> "."+ where+ changesVersion SyncMissing = True+ changesVersion (SyncStale _) = True+ changesVersion _ = False+ pluralize 1 s _ = s+ pluralize _ _ p = p++anyDrift :: SyncReport -> Bool+anyDrift report =+ any+ ( \d -> case d.diffStatus of+ SyncInSync -> False+ _ -> True+ )+ report.syncDiffs++-- | Soft-warning pass: compare each registry entry's 'version' with the+-- on-disk module.dhall / recipe.dhall and return one warning per out-of-sync+-- entry. Entries whose file is missing or unparseable are treated as orphan+-- and excluded here, matching 'formatDriftWarning' (they are already flagged+-- by 'validateRegistry').+--+-- Intended to be called after 'discoverRepoContents' yields 'MultiModule' —+-- the caller has already decoded the registry and knows the repo root.+checkRegistryVersionDrift :: FilePath -> Registry -> IO [Text]+checkRegistryVersionDrift repoRoot reg = do+ lookups <- resolveOnDiskVersions repoRoot reg+ let report = computeRegistrySync reg lookups+ pure (mapMaybe formatDriftWarning report.syncDiffs)
+ src/Seihou/CLI/Registry/Validate.hs view
@@ -0,0 +1,128 @@+module Seihou.CLI.Registry.Validate+ ( ValidateRegistryOpts (..),+ ValidateOutcome (..),+ runValidate,+ handleValidate,+ renderValidationReport,+ )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import GHC.Generics (Generic)+import Seihou.CLI.Registry.Sync (resolveOnDiskVersions)+import Seihou.Core.Registry+ ( RegistryValidationIssue (..),+ RegistryValidationReport (..),+ RepoContents (..),+ discoverRepoContents,+ formatValidationIssue,+ reportHasIssues,+ validateRegistryFull,+ )+import Seihou.Dhall.Eval (evalRegistryFromFile)+import Seihou.Prelude+import System.Directory (doesDirectoryExist)+import System.Exit (ExitCode (..), exitWith)+import System.IO (hPutStrLn, stderr)++-- | Flags parsed for the @seihou registry validate@ subcommand.+data ValidateRegistryOpts = ValidateRegistryOpts+ { validateRegistryDir :: Maybe FilePath+ }+ deriving stock (Eq, Show, Generic)++-- | Terminal outcome of a validate run, decoupled from IO concerns like+-- printing and 'exitWith' so tests can assert without capturing stdout.+data ValidateOutcome+ = -- | Report ran. Caller decides exit code from 'reportHasIssues'.+ ValidateOk RegistryValidationReport+ | -- | Could not even start (no registry at target dir, etc.).+ ValidateFailed Text+ deriving stock (Eq, Show, Generic)++-- | Testable core of @seihou registry validate@. Locates the registry,+-- resolves each entry's on-disk version, and produces the unified report.+runValidate :: ValidateRegistryOpts -> IO ValidateOutcome+runValidate opts = do+ let target = maybe "." id opts.validateRegistryDir+ dirExists <- doesDirectoryExist target+ if not dirExists+ then pure (ValidateFailed ("target directory does not exist: " <> T.pack target))+ else do+ contents <- discoverRepoContents evalRegistryFromFile target+ case contents of+ MultiModule reg -> do+ lookups <- resolveOnDiskVersions target reg+ report <- validateRegistryFull target reg lookups+ pure (ValidateOk report)+ _ ->+ pure+ ( ValidateFailed+ "registry validate requires a seihou-registry.dhall at the target directory"+ )++-- | Handler wired into the CLI command dispatcher. Drives 'runValidate',+-- prints the report, and exits 0 or 1 based on 'reportHasIssues'.+handleValidate :: ValidateRegistryOpts -> IO ()+handleValidate opts = do+ outcome <- runValidate opts+ case outcome of+ ValidateFailed msg -> do+ hPutStrLn stderr ("error: " <> T.unpack msg)+ exitWith (ExitFailure 1)+ ValidateOk report -> do+ TIO.putStr (renderValidationReport report)+ if reportHasIssues report+ then exitWith (ExitFailure 1)+ else exitWith ExitSuccess++-- | Format the report for stdout. Mirrors the wording shown in the ExecPlan+-- example: an "OK" one-liner on success, an "errors:" list with a summary+-- line on failure.+renderValidationReport :: RegistryValidationReport -> Text+renderValidationReport r+ | null r.reportIssues =+ T.unlines+ [ "OK: "+ <> T.pack (show r.reportModuleCount)+ <> " "+ <> pluralize r.reportModuleCount "module" "modules"+ <> ", "+ <> T.pack (show r.reportRecipeCount)+ <> " "+ <> pluralize r.reportRecipeCount "recipe" "recipes"+ <> ", "+ <> T.pack (show r.reportBlueprintCount)+ <> " "+ <> pluralize r.reportBlueprintCount "blueprint" "blueprints"+ <> ", "+ <> T.pack (show r.reportPromptCount)+ <> " "+ <> pluralize r.reportPromptCount "prompt" "prompts"+ <> ", all versions in sync."+ ]+ | otherwise =+ T.unlines $+ ["errors:"]+ <> map ((" " <>) . formatValidationIssue) r.reportIssues+ <> [""]+ <> [summary r]++summary :: RegistryValidationReport -> Text+summary r =+ let n = length r.reportIssues+ hasVersionDrift = any isVersionMismatch r.reportIssues+ base = T.pack (show n) <> " " <> pluralize n "error" "errors"+ tail_ =+ if hasVersionDrift+ then ". Run `seihou registry sync-versions` to fix version drift."+ else "."+ in base <> tail_+ where+ isVersionMismatch (VersionMismatch _) = True+ isVersionMismatch _ = False++pluralize :: Int -> Text -> Text -> Text+pluralize 1 s _ = s+pluralize _ _ p = p
+ src/Seihou/CLI/RemoteVersion.hs view
@@ -0,0 +1,97 @@+module Seihou.CLI.RemoteVersion+ ( FetchError (..),+ fetchTrueModuleVersion,+ renderFetchError,+ )+where++import Data.Text qualified as T+import Seihou.Core.Registry (Registry (..), RegistryEntry (..), RepoContents (..), discoverRepoContents)+import Seihou.Core.Types (Module (..), ModuleName (..))+import Seihou.Dhall.Eval (evalModuleFromFile, evalRegistryFromFile)+import Seihou.Prelude+import System.Directory (doesFileExist)++-- | Reasons a remote-version lookup can fail. These are distinct from+-- "the module declares no version", which is represented by @Right Nothing@+-- in the result of 'fetchTrueModuleVersion'.+data FetchError+ = -- | The repo had no @seihou-registry.dhall@ and no @module.dhall@ at the+ -- root, so the cloned tree exposes nothing we can read. Carries the+ -- path that was checked.+ RegistryNotFound FilePath+ | -- | The repo's @seihou-registry.dhall@ parsed, but no entry whose+ -- @name@ matches the requested module name.+ EntryNotFound ModuleName+ | -- | The path the registry pointed at (or the single-module root) does+ -- not contain a @module.dhall@ file. Carries the absolute path that+ -- was checked.+ ModuleDhallNotFound FilePath+ | -- | Either @seihou-registry.dhall@ or @module.dhall@ failed to evaluate+ -- or decode. Carries a human-readable description of the failure.+ ParseFailed Text+ deriving stock (Show, Eq)++-- | Read the truthful @version@ field of a module declared in a cloned+-- repository. Reads the module's @module.dhall@ directly, ignoring any+-- @version@ field that the registry might also declare.+--+-- The third state in the result, @Right Nothing@, represents a module whose+-- @module.dhall@ declares @version = None Text@ — i.e., an unversioned+-- module. Callers display this as "unversioned" rather than as an error.+--+-- Behavior depends on what the cloned repo contains, as classified by+-- 'discoverRepoContents':+--+-- * 'MultiModule' — look up the registry entry by name, then read+-- @<clone>/<entry.path>/module.dhall@.+-- * 'SingleModule' — read @<clone>/module.dhall@ regardless of the+-- requested name. (Single-module repos host exactly one module; the+-- name in @module.dhall@ is its own source of truth.)+-- * 'SingleRecipe' or 'EmptyRepo' — no module to read; return+-- 'RegistryNotFound'.+fetchTrueModuleVersion :: FilePath -> ModuleName -> IO (Either FetchError (Maybe Text))+fetchTrueModuleVersion clonedRepoPath name = do+ contents <- discoverRepoContents evalRegistryFromFile clonedRepoPath+ case contents of+ SingleModule rootDir ->+ readModuleDhallVersion (rootDir </> "module.dhall")+ MultiModule registry -> case findEntry registry of+ Nothing -> pure (Left (EntryNotFound name))+ Just entry ->+ readModuleDhallVersion (clonedRepoPath </> entry.path </> "module.dhall")+ SingleRecipe _ -> pure (Left (RegistryNotFound clonedRepoPath))+ SingleBlueprint _ -> pure (Left (RegistryNotFound clonedRepoPath))+ SinglePrompt _ -> pure (Left (RegistryNotFound clonedRepoPath))+ EmptyRepo -> pure (Left (RegistryNotFound clonedRepoPath))+ where+ findEntry :: Registry -> Maybe RegistryEntry+ findEntry registry =+ case filter (\e -> e.name == name) registry.modules of+ (entry : _) -> Just entry+ [] -> Nothing++-- | Read a @module.dhall@ at the given path and return its @version@ field.+readModuleDhallVersion :: FilePath -> IO (Either FetchError (Maybe Text))+readModuleDhallVersion path = do+ exists <- doesFileExist path+ if not exists+ then pure (Left (ModuleDhallNotFound path))+ else do+ result <- evalModuleFromFile path+ case result of+ Left err -> pure (Left (ParseFailed (T.pack (show err))))+ Right modul -> pure (Right modul.version)++-- | Render a 'FetchError' as a single-line human-readable message suitable+-- for printing in CLI output ("could not determine remote version: ...").+renderFetchError :: FetchError -> Text+renderFetchError = \case+ RegistryNotFound path ->+ "no module.dhall or seihou-registry.dhall in " <> T.pack path+ EntryNotFound (ModuleName n) ->+ "module '" <> n <> "' not listed in remote registry"+ ModuleDhallNotFound path ->+ "module.dhall not found at " <> T.pack path+ ParseFailed msg ->+ "could not parse remote module: " <> msg
+ src/Seihou/CLI/SavePrompted.hs view
@@ -0,0 +1,84 @@+module Seihou.CLI.SavePrompted+ ( collectPromptedValues,+ offerSavePrompted,+ )+where++import Control.Monad (when)+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Composition.Instance (ModuleInstance)+import Seihou.Core.Types+import Seihou.Effect.ConfigWriter (ConfigWriter, writeConfigValue)+import Seihou.Effect.Console (Console, confirm, putText)+import Seihou.Prelude++-- | Collect variables resolved via interactive prompts that are not already+-- in local config with the same value. Returns triples of (variable name,+-- prompted text value, Just existingValue if overwriting).+collectPromptedValues ::+ Map ModuleInstance (Map VarName ResolvedVar) ->+ Map VarName Text ->+ [(VarName, Text, Maybe Text)]+collectPromptedValues resolved localConfig =+ let allPrompted =+ Map.toAscList $+ Map.unions+ [ Map.mapMaybe promptedOnly vs+ | vs <- Map.elems resolved+ ]+ promptedOnly rv =+ case rv.source of+ FromPrompt -> Just (varValueToText rv.value)+ _ -> Nothing+ in [ (vn, val, existing)+ | (vn, val) <- allPrompted,+ let existing = Map.lookup vn localConfig,+ existing /= Just val+ ]++-- | Offer to save prompted values to local config.+-- Nothing = ask interactively, Just True = auto-save, Just False = skip.+offerSavePrompted ::+ (Console :> es, ConfigWriter :> es) =>+ Maybe Bool ->+ Bool ->+ [(VarName, Text, Maybe Text)] ->+ Eff es ()+offerSavePrompted (Just False) _ _ = pure ()+offerSavePrompted _ _ [] = pure ()+offerSavePrompted mode interactive entries = do+ let shouldSave = case mode of+ Just True -> pure True+ _ | not interactive -> pure False+ _ -> do+ putText ""+ putText "Save prompted values to .seihou/config.dhall?"+ putText ""+ mapM_+ ( \(VarName n, val, mExisting) -> do+ let overwriteNote = case mExisting of+ Just old -> " (overwrites current: \"" <> old <> "\")"+ Nothing -> ""+ putText (" " <> n <> " = \"" <> val <> "\"" <> overwriteNote)+ )+ entries+ putText ""+ confirm "Save? [Y/n]"+ doSave <- shouldSave+ when doSave $ do+ mapM_+ ( \(VarName n, val, _) ->+ writeConfigValue ScopeLocal n val+ )+ entries+ putText $ "Saved " <> T.pack (show (length entries)) <> " value(s) to .seihou/config.dhall"+ putText "Use 'seihou config list' to view or 'seihou config unset <key>' to remove."++-- | Convert a VarValue to its text representation.+varValueToText :: VarValue -> Text+varValueToText (VText t) = t+varValueToText (VBool True) = "true"+varValueToText (VBool False) = "false"+varValueToText (VInt n) = T.pack (show n)+varValueToText (VList vs) = T.intercalate "," (map varValueToText vs)
+ src/Seihou/CLI/SchemaVersion.hs view
@@ -0,0 +1,24 @@+module Seihou.CLI.SchemaVersion+ ( schemaUrl,+ schemaHash,+ schemaImportLine,+ )+where++import Data.Text (Text)++-- | Raw URL for the seihou-schema package.dhall at a pinned commit+schemaUrl :: Text+schemaUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/a0fba0d17b43b14bfdf6d0bf98f1b7ff7af4ebab/package.dhall"++-- | SHA256 integrity hash for the schema import+schemaHash :: Text+schemaHash = "sha256:36250d32d50cec0ea8c74926684ffb8b20f6d0b4f2152930dfa04a1ff108ef3f"++-- | Complete Dhall import line for use in generated modules+schemaImportLine :: Text+schemaImportLine =+ "let S =\n "+ <> schemaUrl+ <> "\n "+ <> schemaHash
@@ -0,0 +1,83 @@+module Seihou.CLI.Shared+ ( formatVarError,+ formatConfigError,+ formatBlueprintRefusal,+ deriveNamespace,+ toVarNameMap,+ logIO,+ unwrapConfig,+ shortenHome,+ )+where++import Data.List (isPrefixOf)+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Effect.Logger (Logger, logError)+import Seihou.Effect.LoggerInterp (runLoggerIO)+import Seihou.Prelude+import System.Directory (getHomeDirectory)+import System.Exit (exitFailure)++-- | Format a 'VarError' for display in CLI output.+formatVarError :: VarError -> Text+formatVarError (MissingRequiredVar (VarName n)) = "missing required variable: " <> n+formatVarError (TypeMismatch (VarName n) _ _) = "type mismatch for variable: " <> n+formatVarError (ValidationFailed (VarName n) msg) = "validation failed for " <> n <> ": " <> msg+formatVarError (CoercionFailed (VarName n) _ raw) = "cannot coerce '" <> raw <> "' for variable: " <> n++-- | Format a 'ConfigError' for display in CLI output.+formatConfigError :: ConfigError -> Text+formatConfigError (ConfigParseError path msg) = T.pack path <> ": " <> msg+formatConfigError (InvalidNamespace ns reason) = "invalid namespace '" <> ns <> "': " <> reason++-- | The canonical message text emitted when @seihou run NAME@ resolves+-- to a blueprint. Returned as a single multi-line string so the run+-- handler can pass it to a single 'logError' call (the logger+-- prefixes each invocation with @[error] @, so emitting the body in+-- one call keeps the prefix off the continuation lines). Kept here in+-- @Seihou.CLI.Shared@ — rather than inlined in @Seihou.CLI.Run@ —+-- specifically so the message can be unit-tested without invoking the+-- full run handler.+formatBlueprintRefusal :: ModuleName -> Text+formatBlueprintRefusal name =+ T.intercalate+ "\n"+ [ "'" <> name.unModuleName <> "' is a blueprint, not a module or recipe.",+ "Blueprints must be run interactively via:",+ " seihou agent run " <> name.unModuleName+ ]++-- | Derive the namespace from a module name by taking the prefix before the first hyphen.+-- For example, @ModuleName "haskell-base"@ yields @"haskell"@.+-- Modules without a hyphen yield an empty text (no namespace).+deriveNamespace :: ModuleName -> Text+deriveNamespace (ModuleName name) =+ let (prefix, _) = T.breakOn "-" name+ in if prefix == name then "" else prefix++-- | Convert a @Map Text Text@ (with text keys like @"project.name"@) to a @Map VarName Text@.+toVarNameMap :: Map.Map Text Text -> Map.Map VarName Text+toVarNameMap = Map.mapKeys VarName++-- | Run a one-shot Logger action in plain IO, using the given verbosity level.+logIO :: LogLevel -> Eff '[Logger, IOE] () -> IO ()+logIO level action = runEff $ runLoggerIO level action++-- | Abbreviate the user's home directory as @~\/@ for display.+shortenHome :: FilePath -> IO Text+shortenHome path = do+ home <- getHomeDirectory+ pure $+ if home `isPrefixOf` path+ then "~/" <> T.pack (drop (length home + 1) path)+ else T.pack path++-- | Unwrap an 'Either ConfigError' in an effectful context, logging an error+-- and exiting on 'Left'.+unwrapConfig :: (IOE :> es) => LogLevel -> Either ConfigError a -> Eff es a+unwrapConfig _ (Right a) = pure a+unwrapConfig level (Left err) = liftIO $ do+ logIO level (logError $ "Error reading config: " <> formatConfigError err)+ exitFailure
+ src/Seihou/CLI/StatusRender.hs view
@@ -0,0 +1,343 @@+module Seihou.CLI.StatusRender+ ( formatStatus,+ ModuleAdvice (..),+ moduleAdvice,+ )+where++import Data.List (intersperse)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time.Format (defaultTimeLocale, formatTime)+import Seihou.CLI.Style (dim, green, red, yellow)+import Seihou.CLI.VersionCompare+ ( OutdatedEntry (..),+ OutdatedStatus (..),+ )+import Seihou.Core.Migration (MigrationPlan (..))+import Seihou.Core.Types+ ( AppliedBlueprint (..),+ AppliedModule (..),+ AppliedRecipe (..),+ Manifest (..),+ ModuleName (..),+ ParentVars (..),+ RecipeName (..),+ TrackedFile (..),+ TrackedFileStatus (..),+ VarName (..),+ )+import Seihou.Core.Version (renderVersion)++-- | What action a single applied-module row recommends.+--+-- Order of precedence: a pending migration always wins over a bare+-- "outdated" annotation, because @seihou migrate@ (after EP-2) is+-- self-contained and one command suffices to bring the project to the+-- new version. An outdated row with no detected pending plan falls+-- back to @seihou upgrade@.+data ModuleAdvice+ = -- | Nothing pending; do not emit a hint.+ AdviceNone+ | -- | Module is outdated and no pending migration was detected. The+ -- renderer prints @"Run: seihou upgrade <name>"@.+ AdviceUpgradeOnly Text+ | -- | A pending migration was detected. The carried 'MigrationPlan'+ -- describes the version range and the in-window migrations that+ -- would run; 'planSteps' may be empty (a pure version bump) or+ -- non-empty. The renderer prints a one-line summary and+ -- @"Run: seihou migrate <name>"@.+ AdvicePendingMigration Text MigrationPlan+ deriving stock (Eq, Show)++-- | Decide which advice to emit for a single applied module. Any+-- detected pending plan wins over a bare outdated annotation because+-- @seihou migrate@ (after EP-2) is self-contained.+moduleAdvice ::+ AppliedModule ->+ Maybe OutdatedStatus ->+ Maybe MigrationPlan ->+ ModuleAdvice+moduleAdvice am mStatus mPlan = case mPlan of+ Just plan -> AdvicePendingMigration am.name.unModuleName plan+ Nothing -> case mStatus of+ Just OutdatedSt -> AdviceUpgradeOnly am.name.unModuleName+ _ -> AdviceNone++-- | Render the full @seihou status@ output as a single 'Text' value.+--+-- @color@ controls ANSI styling; pass 'False' for plain text (used by+-- the test suite).+formatStatus ::+ Bool ->+ Manifest ->+ [TrackedFile] ->+ Maybe [OutdatedEntry] ->+ [(ModuleName, MigrationPlan)] ->+ Text+formatStatus color manifest tracked mEntries pendings =+ T.unlines $+ ["Seihou Status:", ""]+ ++ recipeSection manifest+ ++ blueprintSection manifest+ ++ appliedSection color manifest mEntries pendings+ ++ trackedSection color tracked+ ++ varsSection manifest+ ++ updateSummarySection mEntries+ ++ recommendedActionsSection adviceList+ where+ entryMap = case mEntries of+ Just es -> Map.fromList [(e.moduleName, e) | e <- es]+ Nothing -> Map.empty+ pendingMap =+ Map.fromList [(name.unModuleName, plan) | (name, plan) <- pendings]+ adviceList = map (rowAdvice entryMap pendingMap) manifest.modules++-- | Build a 'ModuleAdvice' for one applied module from the lookup maps.+rowAdvice ::+ Map Text OutdatedEntry ->+ Map Text MigrationPlan ->+ AppliedModule ->+ ModuleAdvice+rowAdvice entryMap pendingMap am =+ let name = am.name.unModuleName+ mStatus = (.status) <$> Map.lookup name entryMap+ mPlan = Map.lookup name pendingMap+ in moduleAdvice am mStatus mPlan++-- ---------------------------------------------------------------------------+-- Section renderers+-- ---------------------------------------------------------------------------++recipeSection :: Manifest -> [Text]+recipeSection manifest = case manifest.recipe of+ Nothing -> []+ Just ar ->+ [ "Recipe: "+ <> ar.name.unRecipeName+ <> maybe "" (\v -> " v" <> v) ar.recipeVersion,+ ""+ ]++-- | Render the "Blueprint:" provenance block when 'Manifest.blueprint'+-- is populated. Empty otherwise.+--+-- Header line: name, optional @vX.Y.Z@, and the applied timestamp.+-- Baseline line: comma-separated baseline module names, or one of the+-- two empty-baseline placeholders.+-- Prompt line: present only when the user passed a positional prompt.+blueprintSection :: Manifest -> [Text]+blueprintSection manifest = case manifest.blueprint of+ Nothing -> []+ Just ab ->+ let header =+ "Blueprint: "+ <> ab.name.unModuleName+ <> maybe "" (\v -> " v" <> v) ab.blueprintVersion+ <> " (applied "+ <> T.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" ab.appliedAt)+ <> ")"+ baselineLine = " Baseline: " <> renderBaseline ab+ promptLines = case ab.userPrompt of+ Nothing -> []+ Just p -> [" Prompt: \"" <> p <> "\""]+ in [header, baselineLine] ++ promptLines ++ [""]++-- | Render the baseline body for the blueprint section. Three cases:+-- @--no-baseline@ was passed, the blueprint declared no baseline at+-- all, or one or more baseline modules were applied.+renderBaseline :: AppliedBlueprint -> Text+renderBaseline ab+ | ab.noBaseline = "(none -- --no-baseline)"+ | null ab.baselineModules = "(none declared)"+ | otherwise =+ T.intercalate ", " (map (.unModuleName) ab.baselineModules)++appliedSection ::+ Bool ->+ Manifest ->+ Maybe [OutdatedEntry] ->+ [(ModuleName, MigrationPlan)] ->+ [Text]+appliedSection color manifest mEntries pendings =+ "Applied modules:"+ : moduleLines+ ++ [""]+ where+ entryMap = case mEntries of+ Just es -> Map.fromList [(e.moduleName, e) | e <- es]+ Nothing -> Map.empty+ pendingMap =+ Map.fromList [(name.unModuleName, plan) | (name, plan) <- pendings]+ moduleLines+ | null manifest.modules = [" (none)"]+ | otherwise =+ concatMap+ ( \am ->+ let advice = rowAdvice entryMap pendingMap am+ annotation = lookupEntry mEntries entryMap am+ headerLine = formatModuleLine color annotation am+ hintLines = formatAdvice color advice+ in headerLine : hintLines+ )+ manifest.modules++trackedSection :: Bool -> [TrackedFile] -> [Text]+trackedSection color tracked =+ ("Tracked files: " <> T.pack (show (length tracked)))+ : ( if null tracked+ then [" (none)"]+ else map (formatTrackedFile color maxPathLen maxModLen) tracked+ )+ ++ [""]+ where+ maxPathLen = maximum (map (length . (.path)) tracked)+ maxModLen = maximum (map (T.length . displayModuleName . (.moduleName)) tracked)++varsSection :: Manifest -> [Text]+varsSection manifest =+ ["Variables: " <> T.pack (show (Map.size manifest.vars)) <> " resolved"]++updateSummarySection :: Maybe [OutdatedEntry] -> [Text]+updateSummarySection Nothing = []+updateSummarySection (Just entries) =+ let total = length entries+ outdated = length (filter (\e -> e.status == OutdatedSt) entries)+ in [ "",+ T.pack (show total)+ <> " module(s) checked, "+ <> T.pack (show outdated)+ <> " outdated."+ ]++-- | Print a "Recommended actions:" block listing the exact commands a+-- user should run for each problem row. Skipped when no row had an+-- actionable problem.+recommendedActionsSection :: [ModuleAdvice] -> [Text]+recommendedActionsSection advices =+ case [c | Just c <- map adviceCommand advices] of+ [] -> []+ cmds -> ["", "Recommended actions:"] ++ map (" " <>) cmds++adviceCommand :: ModuleAdvice -> Maybe Text+adviceCommand AdviceNone = Nothing+adviceCommand (AdviceUpgradeOnly name) = Just ("seihou upgrade " <> name)+adviceCommand (AdvicePendingMigration name _) = Just ("seihou migrate " <> name)++-- ---------------------------------------------------------------------------+-- Per-row formatting+-- ---------------------------------------------------------------------------++-- | Per-row update annotation source, mirroring the previous local+-- @UpdateAnnotation@ enum in @Status.hs@.+data UpdateAnnotation+ = NoCheck+ | NoOrigin+ | Entry OutdatedEntry++lookupEntry ::+ Maybe [OutdatedEntry] ->+ Map Text OutdatedEntry ->+ AppliedModule ->+ UpdateAnnotation+lookupEntry Nothing _ _ = NoCheck+lookupEntry (Just _) m am = case Map.lookup am.name.unModuleName m of+ Just e -> Entry e+ Nothing -> NoOrigin++formatModuleLine :: Bool -> UpdateAnnotation -> AppliedModule -> Text+formatModuleLine color annotation am =+ let verText = case am.moduleVersion of+ Just v -> " " <> applyColor color green ("v" <> v)+ Nothing -> ""+ appliedText =+ " (applied "+ <> T.pack (formatTime defaultTimeLocale "%Y-%m-%d" am.appliedAt)+ <> ")"+ parentVarsText =+ let m = am.parentVars.unParentVars+ in if Map.null m+ then ""+ else+ let pairs =+ T.concat+ ( intersperse+ ", "+ [ vn.unVarName <> "=" <> v+ | (vn, v) <- Map.toAscList m+ ]+ )+ rendered = " [" <> pairs <> "]"+ in applyColor color dim rendered+ updateText = case annotation of+ NoCheck -> ""+ NoOrigin -> " " <> applyColor color dim "(no origin)"+ Entry e -> " " <> renderEntry color e+ in " "+ <> am.name.unModuleName+ <> parentVarsText+ <> verText+ <> appliedText+ <> updateText++-- | Per-row remediation hint. Indented two characters past the row's+-- two-space indentation (i.e. four spaces total) so it visually nests+-- under the module name.+formatAdvice :: Bool -> ModuleAdvice -> [Text]+formatAdvice _ AdviceNone = []+formatAdvice color (AdviceUpgradeOnly name) =+ [" " <> applyColor color yellow ("Run: seihou upgrade " <> name)]+formatAdvice color (AdvicePendingMigration name plan) =+ [" " <> applyColor color yellow (planSummary name plan)]++-- | Format the "Pending migration: from -> to (N step(s)). Run:+-- seihou migrate <name>" line for a pending-migration advice row.+planSummary :: Text -> MigrationPlan -> Text+planSummary name plan =+ "Pending migration: "+ <> renderVersion plan.planFrom+ <> " -> "+ <> renderVersion plan.planTo+ <> " ("+ <> T.pack (show (length plan.planSteps))+ <> " step(s)). Run: seihou migrate "+ <> name++renderEntry :: Bool -> OutdatedEntry -> Text+renderEntry color e = case e.status of+ UpToDate -> applyColor color dim "up to date"+ OutdatedSt ->+ let avail = maybe "?" id e.availableVersion+ txt = "outdated: " <> avail <> " available"+ in applyColor color red txt+ Unversioned -> applyColor color dim "unversioned"+ Unreachable -> applyColor color yellow "unreachable"++formatTrackedFile :: Bool -> Int -> Int -> TrackedFile -> Text+formatTrackedFile color maxPathLen maxModLen tf =+ let path = T.pack tf.path+ modName = displayModuleName tf.moduleName+ paddedPath = path <> T.replicate (maxPathLen - T.length path + 3) " "+ paddedMod = modName <> T.replicate (maxModLen - T.length modName + 3) " "+ label = statusLabel tf.status+ colored = applyColor color (statusColor tf.status) label+ in " " <> paddedPath <> paddedMod <> colored++displayModuleName :: ModuleName -> Text+displayModuleName (ModuleName n) = T.takeWhile (/= '#') n++statusLabel :: TrackedFileStatus -> Text+statusLabel TfsUnchanged = "unchanged"+statusLabel TfsModified = "modified by user"+statusLabel TfsDeleted = "deleted by user"++statusColor :: TrackedFileStatus -> Text -> Text+statusColor TfsUnchanged = dim+statusColor TfsModified = yellow+statusColor TfsDeleted = red++applyColor :: Bool -> (Text -> Text) -> Text -> Text+applyColor True f = f+applyColor False _ = id
+ src/Seihou/CLI/Style.hs view
@@ -0,0 +1,230 @@+module Seihou.CLI.Style+ ( useColor,+ green,+ yellow,+ red,+ magenta,+ dim,+ bold,+ cyan,+ renderPreviewColor,+ renderReportColor,+ formatPlanViewColor,+ )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Types (DiffResult (..), Module (..), ModuleName (..), VarName (..), VarValue (..))+import Seihou.Engine.Preview+import Seihou.Engine.Validate+import Seihou.Prelude+import System.Console.ANSI+ ( Color (..),+ ColorIntensity (..),+ ConsoleIntensity (..),+ ConsoleLayer (..),+ SGR (..),+ hSupportsANSIColor,+ setSGRCode,+ )+import System.IO (stdout)++-- | Check whether stdout supports ANSI color output.+useColor :: IO Bool+useColor = hSupportsANSIColor stdout++-- | Wrap text in ANSI color codes.+withSGR :: [SGR] -> Text -> Text+withSGR codes t =+ T.pack (setSGRCode codes) <> t <> T.pack (setSGRCode [Reset])++green :: Text -> Text+green = withSGR [SetColor Foreground Dull Green]++yellow :: Text -> Text+yellow = withSGR [SetColor Foreground Dull Yellow]++red :: Text -> Text+red = withSGR [SetColor Foreground Vivid Red]++magenta :: Text -> Text+magenta = withSGR [SetColor Foreground Dull Magenta]++dim :: Text -> Text+dim = withSGR [SetConsoleIntensity FaintIntensity]++bold :: Text -> Text+bold = withSGR [SetConsoleIntensity BoldIntensity]++cyan :: Text -> Text+cyan = withSGR [SetColor Foreground Dull Cyan]++-- | Render preview lines with optional ANSI color.+-- When the first argument is False, falls back to plain text.+renderPreviewColor :: Bool -> [PreviewLine] -> Text+renderPreviewColor False lines' = renderPreviewPlain lines'+renderPreviewColor True lines' =+ if null lines'+ then "No operations to perform.\n"+ else T.unlines (map (renderColorLine maxPathLen) fileLines ++ map renderNonFileColor nonFileLines)+ where+ fileLines = [l | l@(FilePreview {}) <- lines']+ nonFileLines = [l | l <- lines', not (isFilePreview' l)]+ maxPathLen = maximum (0 : map (T.length . T.pack . (.previewPath)) fileLines)++renderColorLine :: Int -> PreviewLine -> Text+renderColorLine maxPath (FilePreview status path annotation mMod) =+ let (tag, colorFn) = statusStyleColor status+ pathText = T.pack path+ pathPad = T.replicate (maxPath - T.length pathText) " "+ modSuffix = case mMod of+ Just mn -> ", " <> mn.unModuleName+ Nothing -> ""+ in " " <> tag <> " " <> colorFn pathText <> pathPad <> " " <> dim ("(" <> annotation <> modSuffix <> ")")+renderColorLine _ other = renderNonFileColor other++renderNonFileColor :: PreviewLine -> Text+renderNonFileColor (DirPreview path) =+ " " <> cyan "mkdir" <> " " <> cyan (T.pack path)+renderNonFileColor (CommandPreview cmd) =+ " " <> dim "run" <> " " <> dim cmd+renderNonFileColor (OrphanPreview path modName') =+ " " <> magenta "[orphaned]" <> " " <> magenta (T.pack path) <> " " <> dim ("(orphaned from " <> modName'.unModuleName <> ")")+renderNonFileColor _ = ""++isFilePreview' :: PreviewLine -> Bool+isFilePreview' (FilePreview {}) = True+isFilePreview' _ = False++statusStyleColor :: FileStatus -> (Text, Text -> Text)+statusStyleColor FsNew = (green "[new]", green)+statusStyleColor FsModified = (yellow "[modified]", yellow)+statusStyleColor FsUnchanged = (dim "[unchanged]", dim)+statusStyleColor FsConflict = (bold (red "[conflict]"), bold . red)+statusStyleColor FsOrphaned = (magenta "[orphaned]", magenta)+statusStyleColor FsUnknown = ("[unknown]", id)++-- | Format a complete plan view with optional ANSI color.+formatPlanViewColor :: Bool -> [ModuleName] -> Map VarName VarValue -> [PreviewLine] -> DiffResult -> Text+formatPlanViewColor False modNames vars preview diff = formatPlanView modNames vars preview diff+formatPlanViewColor True modNames vars preview diff =+ T.unlines $+ [header, ""]+ ++ varsSection+ ++ [" Operations:"]+ ++ map (" " <>) (T.lines (renderPreviewColor True preview))+ ++ [""]+ ++ [summaryText']+ where+ header =+ bold+ ( "Generation Plan ("+ <> T.intercalate " + " (map (cyan . (.unModuleName)) modNames)+ <> "):"+ )++ varsSection =+ if Map.null vars+ then []+ else+ " Variables:"+ : map formatVar' (Map.toAscList vars)+ ++ [""]++ maxVarLen = maximum (0 : map (\(VarName n, _) -> T.length n) (Map.toAscList vars))++ formatVar' (VarName name, val) =+ let namePad = T.replicate (maxVarLen - T.length name) " "+ in " " <> name <> namePad <> " = " <> showVarValueColor val++ showVarValueColor (VText t) = cyan ("\"" <> t <> "\"")+ showVarValueColor (VBool True) = cyan "true"+ showVarValueColor (VBool False) = cyan "false"+ showVarValueColor (VInt n) = cyan (T.pack (show n))+ showVarValueColor (VList vs) = "[" <> T.intercalate ", " (map showVarValueColor vs) <> "]"++ nFiles = countNew preview + countMod preview+ nConflicts = countConf preview++ summaryText'+ | nConflicts > 0 =+ " "+ <> T.pack (show nFiles)+ <> " files to write, "+ <> bold (red (T.pack (show nConflicts) <> " conflicts"))+ | otherwise =+ " "+ <> T.pack (show nFiles)+ <> " files to write, "+ <> T.pack (show nConflicts)+ <> " conflicts"++ countNew = length . filter (\l -> case l of FilePreview FsNew _ _ _ -> True; _ -> False)+ countMod = length . filter (\l -> case l of FilePreview FsModified _ _ _ -> True; _ -> False)+ countConf = length . filter (\l -> case l of FilePreview FsConflict _ _ _ -> True; _ -> False)++-- | Render a validation report with optional ANSI color.+-- When the first argument is False, falls back to plain text.+renderReportColor :: Bool -> ValidateReport -> Text+renderReportColor False report = renderReportPlain report+renderReportColor True report =+ T.unlines $+ [ "Validating module at " <> T.pack report.reportPath <> "...",+ ""+ ]+ ++ dhallLine'+ ++ summaryLines'+ ++ checkLines'+ ++ [""]+ ++ [resultLine']+ where+ m = report.reportModule++ dhallLine' =+ if report.reportDhallOk+ then [" " <> green "\x2713" <> " module.dhall evaluates successfully"]+ else+ [" " <> bold (red "\x2717") <> " module.dhall failed to evaluate"]+ ++ case report.reportDhallError of+ Just errText -> [" " <> dim errText]+ Nothing -> []++ summaryLines' =+ if report.reportDhallOk+ then+ [ " " <> green "\x2713" <> " Module name: " <> cyan m.name.unModuleName,+ " " <> green "\x2713" <> " " <> T.pack (show (length m.vars)) <> " variables declared",+ " " <> green "\x2713" <> " " <> T.pack (show (length m.prompts)) <> " prompts defined",+ " " <> green "\x2713" <> " " <> T.pack (show (length m.steps)) <> " steps defined"+ ]+ else []++ checkLines' = concatMap renderCheckColor (report.reportChecks)++ renderCheckColor c+ | null (c.diagDetails) =+ [" " <> green "\x2713" <> " " <> c.diagLabel]+ | c.diagSeverity == DiagWarning =+ (" " <> yellow "\x26A0" <> " " <> yellow (c.diagLabel))+ : map (\d -> " " <> dim d) (c.diagDetails)+ | otherwise =+ (" " <> bold (red "\x2717") <> " " <> red (c.diagLabel))+ : map (\d -> " " <> dim d) (c.diagDetails)++ errorCount =+ length+ [ ()+ | c <- report.reportChecks,+ c.diagSeverity == DiagError,+ not (null (c.diagDetails))+ ]++ dhallFailed = not (report.reportDhallOk)+ totalErrors = errorCount + (if dhallFailed then 1 else 0)++ resultLine'+ | totalErrors > 0 =+ bold (red (T.pack (show totalErrors) <> " error(s) found.")) <> " Module is invalid."+ | otherwise =+ green ("Module '" <> m.name.unModuleName <> "' is valid.")
+ src/Seihou/CLI/VersionCompare.hs view
@@ -0,0 +1,61 @@+module Seihou.CLI.VersionCompare+ ( OutdatedStatus (..),+ OutdatedEntry (..),+ CheckStats (..),+ compareVersions,+ )+where++import Data.Aeson (ToJSON (..), object, (.=))+import Data.Text (Text)+import Seihou.Core.Version (parseVersion)++-- | Status of a module with respect to available updates.+data OutdatedStatus+ = UpToDate+ | OutdatedSt+ | Unversioned+ | Unreachable+ deriving stock (Eq, Show)++-- | A single entry in the outdated report. Shared between the+-- @seihou outdated@ command (which formats them as a table) and+-- @seihou status@ (which folds them into per-row annotations).+data OutdatedEntry = OutdatedEntry+ { moduleName :: Text,+ installedVersion :: Maybe Text,+ availableVersion :: Maybe Text,+ status :: OutdatedStatus+ }+ deriving stock (Eq, Show)++instance ToJSON OutdatedEntry where+ toJSON e =+ object+ [ "module" .= e.moduleName,+ "installed" .= e.installedVersion,+ "available" .= e.availableVersion,+ "status" .= statusText e.status+ ]+ where+ statusText UpToDate = "up to date" :: Text+ statusText OutdatedSt = "outdated"+ statusText Unversioned = "unversioned"+ statusText Unreachable = "unreachable"++-- | Summary statistics for an update check.+data CheckStats = CheckStats+ { checkedCount :: Int,+ skippedNoOrigin :: Int+ }+ deriving stock (Eq, Show)++-- | Compare installed and available version strings.+compareVersions :: Maybe Text -> Maybe Text -> OutdatedStatus+compareVersions (Just instText) (Just availText) =+ case (parseVersion instText, parseVersion availText) of+ (Just instV, Just availV)+ | instV < availV -> OutdatedSt+ | otherwise -> UpToDate+ _ -> Unversioned -- unparseable version treated as unversioned+compareVersions _ _ = Unversioned
+ src/Seihou/Effect/Fzf.hs view
@@ -0,0 +1,21 @@+module Seihou.Effect.Fzf+ ( Fzf (..),+ selectOne,+ isFzfAvailable,+ )+where++import Seihou.Fzf (Candidate, FzfOpts, FzfResult)+import Seihou.Prelude++data Fzf :: Effect where+ SelectOne :: FzfOpts -> [Candidate a] -> Fzf (Eff es) (FzfResult a)+ IsFzfAvailable :: Fzf (Eff es) Bool++type instance DispatchOf Fzf = Dynamic++selectOne :: (Fzf :> es) => FzfOpts -> [Candidate a] -> Eff es (FzfResult a)+selectOne opts cs = send (SelectOne opts cs)++isFzfAvailable :: (Fzf :> es) => Eff es Bool+isFzfAvailable = send IsFzfAvailable
+ src/Seihou/Effect/FzfInterp.hs view
@@ -0,0 +1,27 @@+module Seihou.Effect.FzfInterp+ ( runFzfIO,+ runFzfPure,+ )+where++import Seihou.Effect.Fzf (Fzf (..))+import Seihou.Fzf (FzfConfig, FzfResult (..), isFzfUsable)+import Seihou.Fzf qualified as Fzf+import Seihou.Prelude++-- | Run fzf effects using a real fzf subprocess.+runFzfIO :: (IOE :> es) => FzfConfig -> Eff (Fzf : es) a -> Eff es a+runFzfIO cfg = interpret $ \_ -> \case+ SelectOne opts candidates -> liftIO $ Fzf.runFzf cfg opts candidates+ IsFzfAvailable -> pure (isFzfUsable cfg)++-- | Pure interpreter for testing. Always selects the candidate at the given+-- index, or returns 'FzfNoMatch' if the index is out of bounds.+runFzfPure :: Int -> Eff (Fzf : es) a -> Eff es a+runFzfPure idx = interpret $ \_ -> \case+ SelectOne _ candidates ->+ pure $+ if idx >= 0 && idx < length candidates+ then FzfSelected (candidates !! idx).candidateValue+ else FzfNoMatch+ IsFzfAvailable -> pure True
+ src/Seihou/Fzf.hs view
@@ -0,0 +1,199 @@+module Seihou.Fzf+ ( -- * Config+ FzfConfig (..),+ detectFzfConfig,+ isFzfUsable,++ -- * Options+ FzfOpts (..),+ withPrompt,+ withHeader,+ withHeight,+ withAnsi,+ withNoSort,+ withPreview,+ optsToArgs,++ -- * Candidates and Results+ Candidate (..),+ FzfResult (..),++ -- * Running+ runFzf,+ )+where++import Control.Exception (SomeException, try)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import System.Directory (findExecutable)+import System.Exit (ExitCode (..))+import System.IO (IOMode (..), hClose, hIsTerminalDevice, openFile, stdin)+import System.Process+ ( CreateProcess (..),+ StdStream (..),+ createProcess,+ proc,+ waitForProcess,+ )+import Text.Read (readMaybe)++-- | Runtime configuration for fzf, detected once at CLI startup.+data FzfConfig = FzfConfig+ { fzfBinary :: !FilePath,+ fzfAvailable :: !Bool,+ stdinIsTerminal :: !Bool,+ ttyAvailable :: !Bool+ }+ deriving stock (Eq, Show)++-- | Detect fzf availability and terminal state.+detectFzfConfig :: IO FzfConfig+detectFzfConfig = do+ mFzf <- findExecutable "fzf"+ stdinTerm <- hIsTerminalDevice stdin+ ttyOk <- checkTtyAvailable+ pure+ FzfConfig+ { fzfBinary = maybe "fzf" id mFzf,+ fzfAvailable = case mFzf of Nothing -> False; Just _ -> True,+ stdinIsTerminal = stdinTerm,+ ttyAvailable = ttyOk+ }++-- | Check whether /dev/tty can be opened (for fzf in piped contexts).+checkTtyAvailable :: IO Bool+checkTtyAvailable = do+ result <- try @SomeException $ openFile "/dev/tty" ReadMode+ case result of+ Left _ -> pure False+ Right h -> hClose h >> pure True++-- | Whether fzf can be used for interactive selection.+isFzfUsable :: FzfConfig -> Bool+isFzfUsable cfg = cfg.fzfAvailable && (cfg.stdinIsTerminal || cfg.ttyAvailable)++-- | Composable fzf options. Combine with '<>'.+data FzfOpts = FzfOpts+ { fzfPrompt :: !(Maybe Text),+ fzfHeader :: !(Maybe Text),+ fzfPreview :: !(Maybe Text),+ fzfHeight :: !(Maybe Text),+ fzfAnsi :: !Bool,+ fzfNoSort :: !Bool+ }+ deriving stock (Eq, Show)++instance Semigroup FzfOpts where+ a <> b =+ FzfOpts+ { fzfPrompt = b.fzfPrompt <|> a.fzfPrompt,+ fzfHeader = b.fzfHeader <|> a.fzfHeader,+ fzfPreview = b.fzfPreview <|> a.fzfPreview,+ fzfHeight = b.fzfHeight <|> a.fzfHeight,+ fzfAnsi = a.fzfAnsi || b.fzfAnsi,+ fzfNoSort = a.fzfNoSort || b.fzfNoSort+ }+ where+ (<|>) :: Maybe a -> Maybe a -> Maybe a+ (<|>) Nothing y = y+ (<|>) x _ = x++instance Monoid FzfOpts where+ mempty = FzfOpts Nothing Nothing Nothing Nothing False False++withPrompt :: Text -> FzfOpts+withPrompt p = mempty {fzfPrompt = Just p}++withHeader :: Text -> FzfOpts+withHeader h = mempty {fzfHeader = Just h}++withHeight :: Text -> FzfOpts+withHeight h = mempty {fzfHeight = Just h}++withAnsi :: FzfOpts+withAnsi = mempty {fzfAnsi = True}++withNoSort :: FzfOpts+withNoSort = mempty {fzfNoSort = True}++withPreview :: Text -> FzfOpts+withPreview p = mempty {fzfPreview = Just p}++-- | Convert options to fzf CLI arguments.+optsToArgs :: FzfOpts -> [String]+optsToArgs opts =+ concat+ [ maybe [] (\p -> ["--prompt", T.unpack p]) opts.fzfPrompt,+ maybe [] (\h -> ["--header", T.unpack h]) opts.fzfHeader,+ maybe [] (\p -> ["--preview", T.unpack p]) opts.fzfPreview,+ maybe [] (\h -> ["--height", T.unpack h]) opts.fzfHeight,+ ["--ansi" | opts.fzfAnsi],+ ["--no-sort" | opts.fzfNoSort]+ ]++-- | A selectable candidate with display text and an associated value.+data Candidate a = Candidate+ { candidateDisplay :: !Text,+ candidateValue :: !a+ }+ deriving stock (Functor)++-- | Result of an fzf selection.+data FzfResult a+ = FzfSelected !a+ | FzfNoMatch+ | FzfCancelled+ | FzfError !Text+ deriving stock (Functor)++-- | Run fzf as a subprocess with the given candidates.+--+-- Uses index-based selection: each candidate line is prefixed with a hidden+-- integer index. The index is parsed back from fzf's output to look up the+-- original value, avoiding any issues with special characters in display text.+runFzf :: FzfConfig -> FzfOpts -> [Candidate a] -> IO (FzfResult a)+runFzf _ _ [] = pure FzfNoMatch+runFzf cfg opts candidates+ | not (isFzfUsable cfg) = pure (FzfError "fzf is not available")+ | otherwise = do+ let indexed = zip [0 :: Int ..] candidates+ valueMap = Map.fromList [(i, c.candidateValue) | (i, c) <- indexed]+ inputLines = [show i <> "\t" <> T.unpack c.candidateDisplay | (i, c) <- indexed]+ args = ["-1", "--with-nth=2.."] ++ optsToArgs opts++ let processSpec =+ (proc cfg.fzfBinary args)+ { std_in = CreatePipe,+ std_out = CreatePipe,+ std_err = Inherit,+ delegate_ctlc = True+ }++ result <- try @SomeException $ do+ (Just hIn, Just hOut, _, ph) <- createProcess processSpec+ mapM_ (TIO.hPutStrLn hIn . T.pack) inputLines+ hClose hIn+ outputStr <- TIO.hGetContents hOut+ exitCode <- waitForProcess ph+ pure (exitCode, T.strip outputStr)++ case result of+ Left err -> pure (FzfError (T.pack (show err)))+ Right (exitCode, output) -> case exitCode of+ ExitSuccess -> pure (parseSelection valueMap output)+ ExitFailure 1 -> pure FzfNoMatch+ ExitFailure 130 -> pure FzfCancelled+ ExitFailure n -> pure (FzfError ("fzf exited with code " <> T.pack (show n)))++-- | Parse the index from fzf output and look up the value.+parseSelection :: Map.Map Int a -> Text -> FzfResult a+parseSelection valueMap output =+ let indexText = T.takeWhile (/= '\t') output+ in case readMaybe (T.unpack indexText) of+ Just idx -> case Map.lookup idx valueMap of+ Just val -> FzfSelected val+ Nothing -> FzfError ("invalid index in fzf output: " <> indexText)+ Nothing -> FzfError ("could not parse fzf output: " <> output)
+ src/Seihou/Fzf/Selector.hs view
@@ -0,0 +1,6 @@+module Seihou.Fzf.Selector+ ( module Seihou.Fzf.Selector.Module,+ )+where++import Seihou.Fzf.Selector.Module
+ src/Seihou/Fzf/Selector/Module.hs view
@@ -0,0 +1,62 @@+module Seihou.Fzf.Selector.Module+ ( formatModuleCandidate,+ formatRunnableCandidate,+ defaultModuleOpts,+ selectModule,+ )+where++import Data.Maybe (mapMaybe)+import Data.Text qualified as T+import Seihou.Core.Module (DiscoveredModule (..), DiscoveredRunnable (..), ModuleSource (..), RunnableKind (..), defaultSearchPaths, discoverAllModules, discoverAllRunnables)+import Seihou.Core.Types+import Seihou.Effect.Fzf (Fzf, selectOne)+import Seihou.Fzf (Candidate (..), FzfOpts, FzfResult, withAnsi, withHeight, withNoSort, withPrompt)+import Seihou.Prelude++-- | Format a discovered module as an fzf candidate.+-- Returns 'Nothing' for modules that failed to load.+formatModuleCandidate :: DiscoveredModule -> Maybe (Candidate ModuleName)+formatModuleCandidate dm = case dm.discoveredResult of+ Left _ -> Nothing+ Right m ->+ let nameText = m.name.unModuleName+ descText = maybe "" (\d -> " " <> d) m.description+ sourceTag = case dm.discoveredSource of+ SourceProject -> "[project]"+ SourceUser -> "[user]"+ SourceInstalled -> "[installed]"+ display = nameText <> descText <> " " <> sourceTag+ in Just Candidate {candidateDisplay = display, candidateValue = m.name}++-- | Format a discovered runnable (module or recipe) as an fzf candidate.+-- Returns 'Nothing' for items that failed to load.+formatRunnableCandidate :: DiscoveredRunnable -> Maybe (Candidate ModuleName)+formatRunnableCandidate dr+ | dr.drIsError = Nothing+ | otherwise =+ let nameText = dr.drName+ descText = maybe "" (\d -> " " <> d) dr.drDescription+ kindTag = case dr.drKind of+ KindModule -> ""+ KindRecipe -> " [recipe]"+ KindBlueprint -> " [blueprint]"+ KindPrompt -> " [prompt]"+ sourceTag = case dr.drSource of+ SourceProject -> "[project]"+ SourceUser -> "[user]"+ SourceInstalled -> "[installed]"+ display = nameText <> descText <> kindTag <> " " <> sourceTag+ in Just Candidate {candidateDisplay = display, candidateValue = ModuleName nameText}++-- | Default fzf options for module selection.+defaultModuleOpts :: FzfOpts+defaultModuleOpts = withPrompt "module> " <> withHeight "40%" <> withAnsi <> withNoSort++-- | Discover all available modules and recipes and present them in an fzf picker.+selectModule :: (Fzf :> es, IOE :> es) => Eff es (FzfResult ModuleName)+selectModule = do+ searchPaths <- liftIO defaultSearchPaths+ discovered <- liftIO (discoverAllRunnables searchPaths)+ let candidates = mapMaybe formatRunnableCandidate discovered+ selectOne defaultModuleOpts candidates
+ test/Main.hs view
@@ -0,0 +1,56 @@+module Main (main) where++import Seihou.CLI.AgentCompletionSpec qualified as AgentCompletionSpec+import Seihou.CLI.AgentConfigSpec qualified as AgentConfigSpec+import Seihou.CLI.AgentLaunchSpec qualified as AgentLaunchSpec+import Seihou.CLI.AppliedBlueprintSpec qualified as AppliedBlueprintSpec+import Seihou.CLI.BrowseFormatSpec qualified as BrowseFormatSpec+import Seihou.CLI.CommitMessageSpec qualified as CommitMessageSpec+import Seihou.CLI.DiffSpec qualified as DiffSpec+import Seihou.CLI.ExtensionSpec qualified as ExtensionSpec+import Seihou.CLI.GitSpec qualified as GitSpec+import Seihou.CLI.InitSpec qualified as InitSpec+import Seihou.CLI.InstallHistorySpec qualified as InstallHistorySpec+import Seihou.CLI.ListSpec qualified as ListSpec+import Seihou.CLI.MigrateSpec qualified as MigrateSpec+import Seihou.CLI.PendingMigrationSpec qualified as PendingMigrationSpec+import Seihou.CLI.PromptRenderSpec qualified as PromptRenderSpec+import Seihou.CLI.Registry.SyncSpec qualified as RegistrySyncSpec+import Seihou.CLI.Registry.ValidateSpec qualified as RegistryValidateSpec+import Seihou.CLI.RemoteVersionSpec qualified as RemoteVersionSpec+import Seihou.CLI.RunBlueprintRefusalSpec qualified as RunBlueprintRefusalSpec+import Seihou.CLI.SavePromptedSpec qualified as SavePromptedSpec+import Seihou.CLI.StatusSpec qualified as StatusSpec+import Seihou.CLI.UpgradeSpec qualified as UpgradeSpec+import Seihou.FzfSpec qualified as FzfSpec+import Test.Tasty++main :: IO ()+main = do+ tests <-+ sequence+ [ AgentLaunchSpec.tests,+ AgentCompletionSpec.tests,+ AgentConfigSpec.tests,+ AppliedBlueprintSpec.tests,+ BrowseFormatSpec.tests,+ CommitMessageSpec.tests,+ DiffSpec.tests,+ ExtensionSpec.tests,+ GitSpec.tests,+ InitSpec.tests,+ InstallHistorySpec.tests,+ ListSpec.tests,+ MigrateSpec.tests,+ PendingMigrationSpec.tests,+ PromptRenderSpec.tests,+ RegistrySyncSpec.tests,+ RegistryValidateSpec.tests,+ RemoteVersionSpec.tests,+ RunBlueprintRefusalSpec.tests,+ SavePromptedSpec.tests,+ StatusSpec.tests,+ UpgradeSpec.tests,+ FzfSpec.tests+ ]+ defaultMain (testGroup "seihou-cli" tests)
+ test/Seihou/CLI/AgentCompletionSpec.hs view
@@ -0,0 +1,100 @@+module Seihou.CLI.AgentCompletionSpec (tests) where++import Baikai qualified+import Baikai.Model qualified as BaikaiModel+import Baikai.Response qualified as BaikaiResponse+import Data.Text qualified as Text+import Data.Time (UTCTime)+import Data.Vector qualified as V+import Seihou.CLI.AgentCompletion+import Test.Hspec+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.AgentCompletion" $ do+ describe "provider text helpers" $ do+ it "parses known providers case-insensitively" $ do+ providerFromText "claude-cli" `shouldBe` Right AgentProviderClaudeCli+ providerFromText "CODEX-CLI" `shouldBe` Right AgentProviderCodexCli+ providerFromText " anthropic " `shouldBe` Right AgentProviderAnthropic+ providerFromText "openai" `shouldBe` Right AgentProviderOpenAI++ it "renders providers to canonical config text" $ do+ providerToText AgentProviderClaudeCli `shouldBe` "claude-cli"+ providerToText AgentProviderCodexCli `shouldBe` "codex-cli"+ providerToText AgentProviderAnthropic `shouldBe` "anthropic"+ providerToText AgentProviderOpenAI `shouldBe` "openai"++ it "returns a useful error for unknown providers" $+ providerFromText "llama" `shouldSatisfy` \case+ Left err ->+ "claude-cli" `Text.isInfixOf` err+ && "codex-cli" `Text.isInfixOf` err+ && "anthropic" `Text.isInfixOf` err+ && "openai" `Text.isInfixOf` err+ Right _ -> False++ describe "model construction" $ do+ it "defaults to the Claude CLI provider with no explicit model" $+ defaultAgentModelConfig+ `shouldBe` AgentModelConfig+ { agentProvider = AgentProviderClaudeCli,+ agentModel = Nothing+ }++ it "builds a Claude CLI model using the CLI API tag" $ do+ let model =+ buildBaikaiModel+ AgentModelConfig+ { agentProvider = AgentProviderClaudeCli,+ agentModel = Just "sonnet"+ }+ BaikaiModel.api model `shouldBe` Baikai.AnthropicMessagesCli+ BaikaiModel.provider model `shouldBe` "anthropic"+ BaikaiModel.modelId model `shouldBe` "sonnet"++ it "builds a Codex CLI model using the CLI API tag" $ do+ let model =+ buildBaikaiModel+ AgentModelConfig+ { agentProvider = AgentProviderCodexCli,+ agentModel = Just "gpt-5"+ }+ BaikaiModel.api model `shouldBe` Baikai.OpenAICompletionsCli+ BaikaiModel.provider model `shouldBe` "openai"+ BaikaiModel.modelId model `shouldBe` "gpt-5"++ describe "buildAgentCompletionRequest" $ do+ it "preserves rendered prompts and resolved model configuration" $ do+ let config =+ AgentModelConfig+ { agentProvider = AgentProviderCodexCli,+ agentModel = Just "gpt-5"+ }+ buildAgentCompletionRequest config "system" (Just "user")+ `shouldBe` AgentCompletionRequest+ { completionSystemPrompt = "system",+ completionInitialPrompt = Just "user",+ completionModelConfig = config+ }++ describe "responseText" $ do+ it "extracts and joins assistant text blocks only" $ do+ let resp =+ BaikaiResponse.emptyResponse+ { BaikaiResponse.message =+ Baikai.AssistantPayload+ { Baikai.content =+ V.fromList+ [ Baikai.AssistantText (Baikai.TextContent "hello"),+ Baikai.AssistantThinking Baikai.emptyThinkingContent,+ Baikai.AssistantText (Baikai.TextContent "world")+ ],+ Baikai.usage = Baikai.zeroUsage,+ Baikai.stopReason = Baikai.Stop,+ Baikai.errorMessage = Nothing,+ Baikai.timestamp = Just (read "2026-05-23 00:00:00 UTC" :: UTCTime)+ }+ }+ responseText resp `shouldBe` "hello\nworld"
+ test/Seihou/CLI/AgentConfigSpec.hs view
@@ -0,0 +1,89 @@+module Seihou.CLI.AgentConfigSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as Text+import Seihou.CLI.AgentCompletion+import Seihou.CLI.AgentConfig+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.AgentConfig" spec++spec :: Spec+spec = do+ describe "resolveAgentModelConfig" $ do+ it "uses CLI flags before environment variables" $ do+ resolveAgentModelConfig+ (baseInputs {cliProvider = Just "codex-cli", cliModel = Just "gpt-5", envProvider = Just "anthropic", envModel = Just "claude-sonnet-4-6"})+ `shouldBe` Right+ AgentModelConfig+ { agentProvider = AgentProviderCodexCli,+ agentModel = Just "gpt-5"+ }++ it "uses environment variables before local config" $ do+ resolveAgentModelConfig+ (baseInputs {envProvider = Just "openai", envModel = Just "gpt-4o", localConfig = config "anthropic" "claude-sonnet-4-6"})+ `shouldBe` Right+ AgentModelConfig+ { agentProvider = AgentProviderOpenAI,+ agentModel = Just "gpt-4o"+ }++ it "uses local config before global config" $ do+ resolveAgentModelConfig+ (baseInputs {localConfig = config "anthropic" "claude-opus-4-1", globalConfig = config "openai" "gpt-4o-mini"})+ `shouldBe` Right+ AgentModelConfig+ { agentProvider = AgentProviderAnthropic,+ agentModel = Just "claude-opus-4-1"+ }++ it "falls back to the Claude CLI default" $+ resolveAgentModelConfig baseInputs `shouldBe` Right defaultAgentModelConfig++ it "returns provider diagnostics for invalid provider text" $+ resolveAgentModelConfig (baseInputs {cliProvider = Just "llama"}) `shouldSatisfy` \case+ Left err ->+ "Unknown agent provider" `Text.isInfixOf` err+ && "claude-cli" `Text.isInfixOf` err+ && "codex-cli" `Text.isInfixOf` err+ Right _ -> False++ it "allows a model-only override while keeping the default provider" $+ resolveAgentModelConfig (baseInputs {cliModel = Just "sonnet"})+ `shouldBe` Right+ AgentModelConfig+ { agentProvider = AgentProviderClaudeCli,+ agentModel = Just "sonnet"+ }++ it "ignores blank higher-precedence values" $+ resolveAgentModelConfig+ (baseInputs {cliProvider = Just " ", envProvider = Just "codex-cli", cliModel = Just "", envModel = Just "gpt-5"})+ `shouldBe` Right+ AgentModelConfig+ { agentProvider = AgentProviderCodexCli,+ agentModel = Just "gpt-5"+ }++baseInputs :: AgentConfigInputs+baseInputs =+ AgentConfigInputs+ { cliProvider = Nothing,+ cliModel = Nothing,+ envProvider = Nothing,+ envModel = Nothing,+ localConfig = Map.empty,+ globalConfig = Map.empty+ }++config :: Text -> Text -> Map.Map Text Text+config provider model =+ Map.fromList+ [ (agentProviderConfigKey, provider),+ (agentModelConfigKey, model)+ ]
+ test/Seihou/CLI/AgentLaunchSpec.hs view
@@ -0,0 +1,163 @@+module Seihou.CLI.AgentLaunchSpec (tests) where++import Data.List (nub)+import Data.Text qualified as T+import Seihou.CLI.AgentLaunch+ ( AgentContext (..),+ BaselineStatus (..),+ formatAvailableModules,+ formatBaselineStatus,+ formatBlueprintIdentity,+ formatLocalModules,+ formatManifestState,+ formatModuleDhallState,+ formatReferenceFiles,+ formatReferenceFilesDir,+ formatSeihouProjectState,+ resolveBlueprintTools,+ setupAllowedTools,+ substitute,+ )+import Seihou.Core.Types+ ( Blueprint (..),+ BlueprintFile (..),+ ModuleName (..),+ )+import Test.Hspec+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.AgentLaunch" $ do+ describe "substitute" $ do+ it "replaces a single key" $+ substitute [("name", "Alice")] "Hello {{name}}"+ `shouldBe` "Hello Alice"+ it "replaces multiple keys" $+ substitute [("a", "1"), ("b", "2")] "{{a}}-{{b}}"+ `shouldBe` "1-2"+ it "leaves unknown keys untouched" $+ substitute [("a", "1")] "{{a}} and {{c}}"+ `shouldBe` "1 and {{c}}"+ it "is a no-op on a template with no placeholders" $+ substitute [("a", "1")] "no placeholders here"+ `shouldBe` "no placeholders here"++ describe "AgentContext formatters" $ do+ let baseCtx =+ AgentContext+ { cwd = "/tmp/test",+ seihouInitialized = False,+ hasManifest = False,+ localModuleDhall = False,+ localModules = [],+ availableModules = []+ }++ describe "formatSeihouProjectState" $ do+ it "names .seihou/ when initialised" $+ formatSeihouProjectState (baseCtx {seihouInitialized = True})+ `shouldBe` "Seihou project: .seihou/ directory exists (this is a seihou-managed project)"+ it "states 'No .seihou/' when not initialised" $+ formatSeihouProjectState baseCtx+ `shouldBe` "Seihou project: No .seihou/ directory (not yet a seihou project in this directory)"++ describe "formatManifestState" $ do+ it "names manifest.json when present" $+ formatManifestState (baseCtx {hasManifest = True})+ `shouldBe` "Manifest: .seihou/manifest.json exists (modules have been applied here)"+ it "reports no manifest otherwise" $+ formatManifestState baseCtx+ `shouldBe` "Manifest: No manifest (no modules applied yet)"++ describe "formatModuleDhallState" $ do+ it "names module.dhall when present in cwd" $+ formatModuleDhallState (baseCtx {localModuleDhall = True})+ `shouldBe` "Module in cwd: module.dhall found in current directory (user is authoring a module here)"+ it "is empty when module.dhall is absent" $+ formatModuleDhallState baseCtx `shouldBe` ""++ describe "formatLocalModules" $ do+ it "is empty when there are no local modules" $+ formatLocalModules baseCtx `shouldBe` ""+ it "lists local modules with bullet prefixes" $+ formatLocalModules (baseCtx {localModules = ["foo", "bar"]})+ `shouldBe` "Local modules:\n - foo\n - bar"++ describe "formatAvailableModules" $ do+ it "states 'None discovered' when empty" $+ formatAvailableModules baseCtx+ `shouldBe` "Available modules: None discovered"+ it "renders entries as 'name — description (source)' lines" $+ formatAvailableModules+ (baseCtx {availableModules = [("foo", "the foo module", "user")]})+ `shouldBe` "Available modules across search paths:\n - foo — the foo module (user)"++ describe "formatBaselineStatus" $ do+ it "names --no-baseline as the reason when skipped" $+ formatBaselineStatus BaselineSkipped+ `shouldBe` "(no baseline applied — `--no-baseline` was passed)"+ it "calls out an empty baseModules list" $+ formatBaselineStatus BaselineEmpty+ `shouldBe` "(this blueprint declares no base modules)"+ it "renders an applied versioned module as a bullet" $+ formatBaselineStatus (BaselineApplied [(ModuleName "foo", Just "1.0.0")])+ `shouldBe` " - foo (v1.0.0)"+ it "renders an applied unversioned module as a bullet" $+ formatBaselineStatus (BaselineApplied [(ModuleName "foo", Nothing)])+ `shouldBe` " - foo (unversioned)"++ describe "formatReferenceFiles" $ do+ it "states '(no reference files)' when empty" $+ formatReferenceFiles [] `shouldBe` "(no reference files)"+ it "renders an entry with a description as 'path — description'" $+ formatReferenceFiles [BlueprintFile {src = "x.txt", description = Just "an example"}]+ `shouldBe` " - x.txt — an example"+ it "renders an entry without a description as just the path" $+ formatReferenceFiles [BlueprintFile {src = "y.txt", description = Nothing}]+ `shouldBe` " - y.txt"++ describe "formatReferenceFilesDir" $ do+ it "renders the mounted path with read-directly guidance" $ do+ let rendered = formatReferenceFilesDir (Just "/tmp/bp/files")+ rendered `shouldSatisfy` T.isInfixOf "/tmp/bp/files"+ rendered `shouldSatisfy` T.isInfixOf "open them directly"+ it "renders the ask-the-user fallback when no directory is mounted" $ do+ let rendered = formatReferenceFilesDir Nothing+ rendered `shouldSatisfy` T.isInfixOf "ask the user"+ rendered `shouldSatisfy` (not . T.isInfixOf "readable at")++ describe "resolveBlueprintTools" $ do+ it "returns exactly the base set when nothing is declared" $+ resolveBlueprintTools Nothing `shouldBe` setupAllowedTools+ it "unions declared tools onto the base set without duplicates" $ do+ let result = resolveBlueprintTools (Just ["Bash(mori *)"])+ result `shouldSatisfy` (\tools -> all (`elem` tools) setupAllowedTools)+ result `shouldSatisfy` (elem "Bash(mori *)")+ length result `shouldBe` length (nub result)+ it "does not duplicate a declared base tool" $+ resolveBlueprintTools (Just ["Read"]) `shouldBe` setupAllowedTools++ describe "formatBlueprintIdentity" $ do+ let mk v d =+ Blueprint+ { name = ModuleName "bp",+ version = v,+ description = d,+ prompt = "",+ vars = [],+ prompts = [],+ baseModules = [],+ files = [],+ allowedTools = Nothing,+ tags = []+ }+ it "renders name, version, description as a three-line block" $+ formatBlueprintIdentity (mk (Just "0.1") (Just "a thing"))+ `shouldBe` "Name: bp\nVersion: 0.1\nDescription: a thing"+ it "names '(unspecified)' when version is missing" $+ formatBlueprintIdentity (mk Nothing (Just "a thing"))+ `shouldBe` "Name: bp\nVersion: (unspecified)\nDescription: a thing"+ it "names '(no description)' when description is missing" $+ formatBlueprintIdentity (mk (Just "0.1") Nothing)+ `shouldBe` "Name: bp\nVersion: 0.1\nDescription: (no description)"
+ test/Seihou/CLI/AppliedBlueprintSpec.hs view
@@ -0,0 +1,106 @@+module Seihou.CLI.AppliedBlueprintSpec (tests) where++import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Seihou.CLI.AppliedBlueprint (recordAppliedBlueprint)+import Seihou.Core.Types+ ( AppliedBlueprint (..),+ AppliedRecipe (..),+ Manifest (..),+ ModuleName (..),+ RecipeName (..),+ )+import Seihou.Manifest.Types (currentManifestVersion, emptyManifest, manifestFromJSON, manifestToJSON)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.AppliedBlueprint" spec++fixedTime :: UTCTime+fixedTime =+ parseTimeOrError+ True+ defaultTimeLocale+ "%Y-%m-%dT%H:%M:%SZ"+ "2026-05-12T14:23:00Z"++mkEntry :: Text -> Maybe Text -> [Text] -> Bool -> Maybe Text -> AppliedBlueprint+mkEntry name mver baseline noBL prompt =+ AppliedBlueprint+ { name = ModuleName name,+ blueprintVersion = mver,+ appliedAt = fixedTime,+ baselineModules = map ModuleName baseline,+ noBaseline = noBL,+ userPrompt = prompt,+ agentSessionId = Nothing+ }++readManifestFile :: FilePath -> IO Manifest+readManifestFile path = do+ bs <- LBS.readFile path+ case manifestFromJSON bs of+ Right m -> pure m+ Left err -> error ("test fixture: malformed manifest: " <> err)++spec :: Spec+spec = do+ describe "recordAppliedBlueprint" $ do+ it "creates a fresh manifest when none exists" $+ withSystemTempDirectory "seihou-ab" $ \dir -> do+ let manifestPath = dir </> ".seihou" </> "manifest.json"+ entry = mkEntry "payments-service" (Just "0.3.1") ["nix-flake"] False (Just "set up payments")+ res <- recordAppliedBlueprint manifestPath entry+ res `shouldBe` Right ()+ m <- readManifestFile manifestPath+ m.version `shouldBe` currentManifestVersion+ m.blueprint `shouldBe` Just entry++ it "preserves unrelated manifest fields" $+ withSystemTempDirectory "seihou-ab" $ \dir -> do+ let manifestPath = dir </> "manifest.json"+ seedRecipe =+ AppliedRecipe+ { name = RecipeName "haskell-library",+ recipeVersion = Just "1.2.0",+ appliedAt = fixedTime+ }+ seed =+ (emptyManifest fixedTime)+ { recipe = Just seedRecipe,+ vars = Map.empty+ }+ LBS.writeFile manifestPath (manifestToJSON seed)+ let entry = mkEntry "payments-service" Nothing [] True Nothing+ res <- recordAppliedBlueprint manifestPath entry+ res `shouldBe` Right ()+ m <- readManifestFile manifestPath+ m.recipe `shouldBe` Just seedRecipe+ m.blueprint `shouldBe` Just entry++ it "overwrites a prior blueprint entry" $+ withSystemTempDirectory "seihou-ab" $ \dir -> do+ let manifestPath = dir </> "manifest.json"+ ab1 = mkEntry "first" Nothing [] False Nothing+ ab2 = mkEntry "second" (Just "0.2.0") ["base"] False (Just "second run")+ _ <- recordAppliedBlueprint manifestPath ab1+ _ <- recordAppliedBlueprint manifestPath ab2+ m <- readManifestFile manifestPath+ m.blueprint `shouldBe` Just ab2++ it "returns Left when the existing manifest is unreadable" $+ withSystemTempDirectory "seihou-ab" $ \dir -> do+ let manifestPath = dir </> "manifest.json"+ writeFile manifestPath "{ this is not valid json"+ let entry = mkEntry "x" Nothing [] False Nothing+ res <- recordAppliedBlueprint manifestPath entry+ case res of+ Left err -> err `shouldSatisfy` not . T.null+ Right () -> expectationFailure "expected Left for corrupt manifest"
+ test/Seihou/CLI/BrowseFormatSpec.hs view
@@ -0,0 +1,211 @@+module Seihou.CLI.BrowseFormatSpec (tests) where++import Data.Text (Text, pack)+import Seihou.CLI.BrowseFormat (formatBrowseRegistry, formatBrowseSingleBlueprint, formatBrowseSingleModule, formatBrowseSinglePrompt)+import Seihou.Core.Registry (EntryKind (..), Registry (..), RegistryEntry (..))+import Seihou.Core.Types (ModuleName (..))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.BrowseFormat" spec++mkEntry :: String -> String -> Maybe String -> [String] -> RegistryEntry+mkEntry n p desc ts =+ RegistryEntry+ { name = ModuleName (pack n),+ version = Nothing,+ path = p,+ description = fmap pack desc,+ tags = map pack ts+ }++mkRegistry :: String -> Maybe String -> [RegistryEntry] -> Registry+mkRegistry n desc ms =+ Registry+ { repoName = pack n,+ repoDescription = fmap pack desc,+ modules = ms,+ recipes = [],+ blueprints = [],+ prompts = []+ }++asModules :: [RegistryEntry] -> [(EntryKind, RegistryEntry)]+asModules = map ((,) ModuleEntry)++spec :: Spec+spec = do+ describe "formatBrowseSingleModule" $ do+ it "formats single module with description" $ do+ let result = formatBrowseSingleModule "https://github.com/user/repo" "haskell-base" (Just "Base Haskell setup")+ result+ `shouldBe` "haskell-base\n\+ \ Base Haskell setup\n\+ \\n\+ \Single-module repository. Install with:\n\+ \ seihou install https://github.com/user/repo\n"++ it "formats single module without description" $ do+ let result = formatBrowseSingleModule "https://github.com/user/repo" "minimal" Nothing+ result+ `shouldBe` "minimal\n\+ \\n\+ \Single-module repository. Install with:\n\+ \ seihou install https://github.com/user/repo\n"++ describe "formatBrowseSingleBlueprint" $ do+ it "formats single blueprint with description" $ do+ let result = formatBrowseSingleBlueprint "https://github.com/user/bp" "payments-service" (Just "Agent-driven payments scaffold")+ result+ `shouldBe` "payments-service\n\+ \ Agent-driven payments scaffold\n\+ \\n\+ \Single-blueprint repository. Install with:\n\+ \ seihou install https://github.com/user/bp\n"++ it "formats single blueprint without description" $ do+ let result = formatBrowseSingleBlueprint "https://github.com/user/bp" "minimal-bp" Nothing+ result+ `shouldBe` "minimal-bp\n\+ \\n\+ \Single-blueprint repository. Install with:\n\+ \ seihou install https://github.com/user/bp\n"++ describe "formatBrowseSinglePrompt" $ do+ it "formats single prompt with description" $ do+ let result = formatBrowseSinglePrompt "https://github.com/user/prompt" "review-changes" (Just "Review the current diff")+ result+ `shouldBe` "review-changes\n\+ \ Review the current diff\n\+ \\n\+ \Single-prompt repository. Install with:\n\+ \ seihou install https://github.com/user/prompt\n"++ it "formats single prompt without description" $ do+ let result = formatBrowseSinglePrompt "https://github.com/user/prompt" "quick-note" Nothing+ result+ `shouldBe` "quick-note\n\+ \\n\+ \Single-prompt repository. Install with:\n\+ \ seihou install https://github.com/user/prompt\n"++ describe "formatBrowseRegistry" $ do+ it "formats multi-module registry with kind labels" $ do+ let entries =+ [ mkEntry "haskell-base" "modules/haskell-base" (Just "Base Haskell project") ["haskell"],+ mkEntry "nix-flake" "modules/nix-flake" (Just "Nix flake setup") ["nix", "devops"]+ ]+ registry = mkRegistry "my-templates" (Just "A collection of project templates") entries+ result = formatBrowseRegistry "https://github.com/user/templates" registry (asModules entries) Nothing+ result+ `shouldBe` "my-templates\n\+ \A collection of project templates\n\+ \\n\+ \Available entries:\n\+ \\n\+ \ [module] haskell-base Base Haskell project [haskell]\n\+ \ [module] nix-flake Nix flake setup [nix, devops]\n\+ \\n\+ \2 entries available. Install with:\n\+ \ seihou install https://github.com/user/templates --module <name>\n\+ \ seihou install https://github.com/user/templates --all\n"++ it "formats registry with no description" $ do+ let entries = [mkEntry "only-mod" "modules/only-mod" (Just "The only module") []]+ registry = mkRegistry "simple-repo" Nothing entries+ result = formatBrowseRegistry "https://github.com/user/repo" registry (asModules entries) Nothing+ result+ `shouldBe` "simple-repo\n\+ \\n\+ \Available entries:\n\+ \\n\+ \ [module] only-mod The only module\n\+ \\n\+ \1 entry available. Install with:\n\+ \ seihou install https://github.com/user/repo --module <name>\n\+ \ seihou install https://github.com/user/repo --all\n"++ it "formats empty registry" $ do+ let registry = mkRegistry "empty-repo" (Just "Nothing here") []+ result = formatBrowseRegistry "source" registry [] Nothing+ result+ `shouldBe` "empty-repo\n\+ \Nothing here\n\+ \\n\+ \No entries in registry.\n"++ it "formats tag filter with no matches" $ do+ let registry = mkRegistry "my-templates" Nothing []+ result = formatBrowseRegistry "source" registry [] (Just "rust")+ result+ `shouldBe` "my-templates\n\+ \\n\+ \No entries matching tag 'rust'.\n"++ it "formats filtered results by tag" $ do+ let allMods =+ [ mkEntry "haskell-base" "modules/haskell-base" (Just "Haskell setup") ["haskell"],+ mkEntry "nix-flake" "modules/nix-flake" (Just "Nix flake") ["nix"]+ ]+ filtered = [head allMods] -- only the haskell one+ registry = mkRegistry "templates" Nothing allMods+ result = formatBrowseRegistry "source" registry (asModules filtered) (Just "haskell")+ result+ `shouldBe` "templates\n\+ \\n\+ \Available entries:\n\+ \\n\+ \ [module] haskell-base Haskell setup [haskell]\n\+ \\n\+ \1 entry available. Install with:\n\+ \ seihou install source --module <name>\n\+ \ seihou install source --all\n"++ it "aligns columns when names have different lengths" $ do+ let entries =+ [ mkEntry "a" "modules/a" (Just "Short name") [],+ mkEntry "very-long-module-name" "modules/vlmn" (Just "Long name") []+ ]+ registry = mkRegistry "repo" Nothing entries+ result = formatBrowseRegistry "source" registry (asModules entries) Nothing+ -- The short name should be padded to match the longest+ result+ `shouldBe` "repo\n\+ \\n\+ \Available entries:\n\+ \\n\+ \ [module] a Short name\n\+ \ [module] very-long-module-name Long name\n\+ \\n\+ \2 entries available. Install with:\n\+ \ seihou install source --module <name>\n\+ \ seihou install source --all\n"++ it "formats a mixed-kind registry with module, recipe, blueprint, and prompt labels" $ do+ let modEntry = mkEntry "haskell-base" "modules/haskell-base" (Just "Module entry") ["haskell"]+ recEntry = mkEntry "lib-recipe" "recipes/lib-recipe" (Just "Recipe entry") []+ bpEntry = mkEntry "payments-service" "blueprints/payments-service" (Just "Blueprint entry") []+ promptEntry = mkEntry "review-changes" "prompts/review-changes" (Just "Prompt entry") ["review"]+ mixed =+ [ (ModuleEntry, modEntry),+ (RecipeEntry, recEntry),+ (BlueprintEntry, bpEntry),+ (PromptEntry, promptEntry)+ ]+ registry = mkRegistry "mixed-repo" Nothing [modEntry]+ result = formatBrowseRegistry "source" registry mixed Nothing+ result+ `shouldBe` "mixed-repo\n\+ \\n\+ \Available entries:\n\+ \\n\+ \ [module] haskell-base Module entry [haskell]\n\+ \ [recipe] lib-recipe Recipe entry\n\+ \ [blueprint] payments-service Blueprint entry\n\+ \ [prompt] review-changes Prompt entry [review]\n\+ \\n\+ \4 entries available. Install with:\n\+ \ seihou install source --module <name>\n\+ \ seihou install source --all\n"
+ test/Seihou/CLI/CommitMessageSpec.hs view
@@ -0,0 +1,47 @@+module Seihou.CLI.CommitMessageSpec (tests) where++import Data.Text qualified as T+import Seihou.CLI.CommitMessage (generateCommitMessage, stripCodeFence)+import Seihou.Core.Types (ModuleName (..))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.CommitMessage" spec++spec :: Spec+spec = do+ describe "generateCommitMessage" $ do+ it "returns a non-empty message for a single module" $ do+ msg <- generateCommitMessage [ModuleName "haskell-base"] "diff content"+ T.null msg `shouldBe` False++ it "returns a non-empty message for multiple modules" $ do+ msg <- generateCommitMessage [ModuleName "base", ModuleName "extras"] "diff content"+ T.null msg `shouldBe` False++ it "returns a non-empty message with empty diff" $ do+ msg <- generateCommitMessage [ModuleName "haskell-base"] ""+ T.null msg `shouldBe` False++ describe "stripCodeFence" $ do+ it "strips triple-backtick fencing" $ do+ stripCodeFence "```\nfeat: apply module\n```" `shouldBe` "feat: apply module"++ it "strips fencing with language tag" $ do+ stripCodeFence "```text\nfeat: apply module\n```" `shouldBe` "feat: apply module"++ it "leaves unfenced text unchanged" $ do+ stripCodeFence "feat: apply module" `shouldBe` "feat: apply module"++ it "leaves text with backticks in the middle unchanged" $ do+ let input = "feat: use ```code``` in template"+ stripCodeFence input `shouldBe` input++ it "handles empty input" $ do+ stripCodeFence "" `shouldBe` ""++ it "preserves multiline commit messages inside fences" $ do+ stripCodeFence "```\nfeat: apply modules\n\nApply base and extras.\n```"+ `shouldBe` "feat: apply modules\n\nApply base and extras."
+ test/Seihou/CLI/DiffSpec.hs view
@@ -0,0 +1,70 @@+module Seihou.CLI.DiffSpec (tests) where++import Data.Text qualified as T+import Seihou.CLI.Diff (formatDiffOutput)+import Seihou.Core.Types (ModuleName (..), TrackedFile (..), TrackedFileStatus (..))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Diff" spec++spec :: Spec+spec = do+ describe "formatDiffOutput" $ do+ it "shows no-changes message when all files unchanged" $ do+ let tracked =+ [ TrackedFile "README.md" (ModuleName "haskell-base") TfsUnchanged,+ TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsUnchanged+ ]+ result = formatDiffOutput False tracked+ 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+ 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+ T.isInfixOf "modified" result `shouldBe` True+ T.isInfixOf "src/Lib.hs" result `shouldBe` True++ it "shows deleted files" $ do+ let tracked =+ [ TrackedFile "app/Main.hs" (ModuleName "haskell-base") TfsDeleted+ ]+ result = formatDiffOutput False tracked+ T.isInfixOf "deleted" result `shouldBe` True+ T.isInfixOf "app/Main.hs" result `shouldBe` True++ it "shows summary count line" $ do+ let tracked =+ [ TrackedFile "README.md" (ModuleName "haskell-base") TfsUnchanged,+ TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsModified,+ TrackedFile "app/Main.hs" (ModuleName "haskell-base") TfsDeleted+ ]+ result = formatDiffOutput False tracked+ 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+ T.isInfixOf "(haskell-base)" result `shouldBe` True++ it "hides unchanged files from main listing" $ do+ let tracked =+ [ TrackedFile "README.md" (ModuleName "haskell-base") TfsUnchanged,+ TrackedFile "src/Lib.hs" (ModuleName "haskell-base") TfsModified+ ]+ result = formatDiffOutput False tracked+ bodyLines = filter (T.isInfixOf "README.md") (T.lines result)+ bodyLines `shouldBe` []
+ test/Seihou/CLI/ExtensionSpec.hs view
@@ -0,0 +1,64 @@+module Seihou.CLI.ExtensionSpec (tests) where++import Control.Exception (bracket_)+import Seihou.CLI.Extension+import System.Directory+ ( getPermissions,+ setOwnerExecutable,+ setPermissions,+ )+import System.Environment (getEnv, setEnv)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Extension" spec++spec :: Spec+spec = do+ describe "extensionExecutableName" $ do+ it "uses the seihou extension executable naming convention" $ do+ extensionExecutableName "okf" `shouldBe` "seihou-okf-extension"++ describe "runExtension" $ do+ it "reports a missing executable by its resolved name" $ do+ result <- runExtension (ExtensionRunOpts "missing-extension-spec" ["--help"])+ result `shouldBe` Left (ExtensionNotFound "missing-extension-spec" "seihou-missing-extension-spec-extension")++ it "forwards arguments to the resolved extension executable unchanged" $+ withSystemTempDirectory "seihou-extension-spec" $ \dir -> do+ let exePath = dir </> "seihou-okf-extension"+ argsPath = dir </> "args.txt"+ writeFile exePath $+ unlines+ [ "#!/bin/sh",+ "printf '%s\\n' \"$@\" > " <> show argsPath+ ]+ permissions <- getPermissions exePath+ setPermissions exePath (setOwnerExecutable True permissions)+ withPrependedPath dir $ do+ result <- runExtension (ExtensionRunOpts "okf" ["docs", "--dir", "."])+ result `shouldBe` Right ()+ readFile argsPath `shouldReturn` "docs\n--dir\n.\n"++ it "reports the extension exit code when the executable fails" $+ withSystemTempDirectory "seihou-extension-failure-spec" $ \dir -> do+ let exePath = dir </> "seihou-okf-extension"+ writeFile exePath "#!/bin/sh\nexit 42\n"+ permissions <- getPermissions exePath+ setPermissions exePath (setOwnerExecutable True permissions)+ withPrependedPath dir $ do+ result <- runExtension (ExtensionRunOpts "okf" [])+ result `shouldBe` Left (ExtensionExited "okf" (ExitFailure 42))++withPrependedPath :: FilePath -> IO a -> IO a+withPrependedPath dir action = do+ originalPath <- getEnv "PATH"+ bracket_+ (setEnv "PATH" (dir <> ":" <> originalPath))+ (setEnv "PATH" originalPath)+ action
+ test/Seihou/CLI/GitSpec.hs view
@@ -0,0 +1,132 @@+module Seihou.CLI.GitSpec (tests) where++import Seihou.CLI.Git (gitAdd, gitCheckIgnore, gitCommit, gitDiffCached, isGitRepo)+import Seihou.Effect.ProcessPure (ProcessMock (..), runProcessPure)+import Seihou.Prelude+import System.Exit (ExitCode (..))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Git" spec++spec :: Spec+spec = do+ describe "isGitRepo" $ do+ it "returns True when git rev-parse succeeds" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["rev-parse", "--is-inside-work-tree"]+ (ExitSuccess, "true\n", "")+ ]+ result <- runEff $ runProcessPure mocks isGitRepo+ result `shouldBe` True++ it "returns False when git rev-parse fails" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["rev-parse", "--is-inside-work-tree"]+ (ExitFailure 128, "", "fatal: not a git repository\n")+ ]+ result <- runEff $ runProcessPure mocks isGitRepo+ result `shouldBe` False++ it "returns False when git is not found" $ do+ result <- runEff $ runProcessPure [] isGitRepo+ result `shouldBe` False++ describe "gitAdd" $ do+ it "stages specified files" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["add", "README.md", "src/Lib.hs"]+ (ExitSuccess, "", "")+ ]+ (exitCode, _, _) <- runEff $ runProcessPure mocks $ gitAdd ["README.md", "src/Lib.hs"]+ exitCode `shouldBe` ExitSuccess++ it "returns failure for nonexistent files" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["add", "missing.txt"]+ (ExitFailure 128, "", "fatal: pathspec 'missing.txt' did not match any files\n")+ ]+ (exitCode, _, _) <- runEff $ runProcessPure mocks $ gitAdd ["missing.txt"]+ exitCode `shouldBe` ExitFailure 128++ describe "gitCommit" $ do+ it "creates a commit with given message" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["commit", "-m", "feat: add scaffolding"]+ (ExitSuccess, "[main abc1234] feat: add scaffolding\n 2 files changed\n", "")+ ]+ (exitCode, _, _) <- runEff $ runProcessPure mocks $ gitCommit "feat: add scaffolding"+ exitCode `shouldBe` ExitSuccess++ it "returns failure when nothing to commit" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["commit", "-m", "empty"]+ (ExitFailure 1, "", "nothing to commit, working tree clean\n")+ ]+ (exitCode, _, stderr) <- runEff $ runProcessPure mocks $ gitCommit "empty"+ exitCode `shouldBe` ExitFailure 1+ stderr `shouldBe` "nothing to commit, working tree clean\n"++ describe "gitCheckIgnore" $ do+ it "returns ignored files when git check-ignore succeeds" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["check-ignore", "README.md", "dist/bundle.js", ".env"]+ (ExitSuccess, "dist/bundle.js\n.env\n", "")+ ]+ result <- runEff $ runProcessPure mocks $ gitCheckIgnore ["README.md", "dist/bundle.js", ".env"]+ result `shouldBe` ["dist/bundle.js", ".env"]++ it "returns empty list when no files are ignored (exit 1)" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["check-ignore", "README.md", "src/Lib.hs"]+ (ExitFailure 1, "", "")+ ]+ result <- runEff $ runProcessPure mocks $ gitCheckIgnore ["README.md", "src/Lib.hs"]+ result `shouldBe` []++ it "returns empty list on error (exit 128)" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["check-ignore", "README.md"]+ (ExitFailure 128, "", "fatal: not a git repository\n")+ ]+ result <- runEff $ runProcessPure mocks $ gitCheckIgnore ["README.md"]+ result `shouldBe` []++ it "returns empty list for empty input" $ do+ result <- runEff $ runProcessPure [] $ gitCheckIgnore []+ result `shouldBe` []++ describe "gitDiffCached" $ do+ it "returns stat and diff combined" $ do+ let mocks =+ [ ProcessMock+ "git"+ ["diff", "--cached", "--stat"]+ (ExitSuccess, " README.md | 1 +\n", ""),+ ProcessMock+ "git"+ ["diff", "--cached"]+ (ExitSuccess, "+hello world\n", "")+ ]+ result <- runEff $ runProcessPure mocks gitDiffCached+ result `shouldBe` " README.md | 1 +\n\n+hello world\n"
+ test/Seihou/CLI/InitSpec.hs view
@@ -0,0 +1,62 @@+module Seihou.CLI.InitSpec (tests) where++import Data.Text qualified as T+import Seihou.CLI.Init (formatInitOutput)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Init" spec++spec :: Spec+spec = do+ describe "formatInitOutput" $ do+ it "includes header with base path" $ do+ let result = formatInitOutput "~/.config/seihou" []+ T.isInfixOf "Initialized Seihou configuration at ~/.config/seihou/" result+ `shouldBe` True++ it "shows Created: for newly created items" $ do+ let items = [("config.dhall", "global defaults", True)]+ result = formatInitOutput "~/.config/seihou" items+ T.isInfixOf "Created: config.dhall (global defaults)" result+ `shouldBe` True++ it "shows Exists: for already existing items" $ do+ let items = [("config.dhall", "global defaults", False)]+ result = formatInitOutput "~/.config/seihou" items+ T.isInfixOf "Exists: config.dhall (global defaults)" result+ `shouldBe` True++ it "formats all three spec items correctly when all created" $ do+ let items =+ [ ("config.dhall", "global defaults", True),+ ("modules/", "user modules", True),+ ("installed/", "git-installed modules", True)+ ]+ result = formatInitOutput "~/.config/seihou" items+ resultLines = T.lines result+ length resultLines `shouldBe` 4+ (resultLines !! 0) `shouldBe` "Initialized Seihou configuration at ~/.config/seihou/"+ (resultLines !! 1) `shouldBe` " Created: config.dhall (global defaults)"+ (resultLines !! 2) `shouldBe` " Created: modules/ (user modules)"+ (resultLines !! 3) `shouldBe` " Created: installed/ (git-installed modules)"++ it "formats mixed created and existing items" $ do+ let items =+ [ ("config.dhall", "global defaults", False),+ ("modules/", "user modules", True),+ ("installed/", "git-installed modules", False)+ ]+ result = formatInitOutput "~/.config/seihou" items+ resultLines = T.lines result+ (resultLines !! 1) `shouldBe` " Exists: config.dhall (global defaults)"+ (resultLines !! 2) `shouldBe` " Created: modules/ (user modules)"+ (resultLines !! 3) `shouldBe` " Exists: installed/ (git-installed modules)"++ it "uses two-space indentation for items" $ do+ let items = [("test.txt", "test file", True)]+ result = formatInitOutput "~/path" items+ resultLines = T.lines result+ T.isPrefixOf " " (resultLines !! 1) `shouldBe` True
+ test/Seihou/CLI/InstallHistorySpec.hs view
@@ -0,0 +1,86 @@+module Seihou.CLI.InstallHistorySpec (tests) where++import Data.Text qualified as T+import Seihou.CLI.InstallHistory+ ( HistoryEntry (..),+ InstallHistory (..),+ maxHistoryEntries,+ readHistoryFrom,+ recordUrlTo,+ writeHistoryTo,+ )+import System.Directory (doesFileExist)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.InstallHistory" spec++spec :: Spec+spec = do+ describe "readHistoryFrom" $ do+ it "returns empty history when file does not exist" $ do+ withSystemTempDirectory "history-test" $ \tmp -> do+ h <- readHistoryFrom (tmp </> "nonexistent.json")+ h.entries `shouldBe` []++ it "returns empty history for malformed JSON" $ do+ withSystemTempDirectory "history-test" $ \tmp -> do+ let path = tmp </> "bad.json"+ writeFile path "not json"+ h <- readHistoryFrom path+ h.entries `shouldBe` []++ describe "writeHistoryTo / readHistoryFrom round-trip" $ do+ it "round-trips an empty history" $ do+ withSystemTempDirectory "history-test" $ \tmp -> do+ let path = tmp </> "history.json"+ original = InstallHistory []+ writeHistoryTo path original+ result <- readHistoryFrom path+ result `shouldBe` original++ it "round-trips a history with entries" $ do+ withSystemTempDirectory "history-test" $ \tmp -> do+ let path = tmp </> "history.json"+ original =+ InstallHistory+ [ HistoryEntry "https://github.com/a/b.git" "2026-01-01T00:00:00Z",+ HistoryEntry "https://github.com/c/d.git" "2025-12-01T00:00:00Z"+ ]+ writeHistoryTo path original+ result <- readHistoryFrom path+ result `shouldBe` original++ describe "recordUrlTo" $ do+ it "creates a history file when none exists" $ do+ withSystemTempDirectory "history-test" $ \tmp -> do+ let path = tmp </> "history.json"+ recordUrlTo path "https://github.com/foo/bar.git"+ exists <- doesFileExist path+ exists `shouldBe` True+ h <- readHistoryFrom path+ length h.entries `shouldBe` 1+ (head h.entries).url `shouldBe` "https://github.com/foo/bar.git"++ it "deduplicates by URL, keeping most recent first" $ do+ withSystemTempDirectory "history-test" $ \tmp -> do+ let path = tmp </> "history.json"+ recordUrlTo path "https://github.com/a/first.git"+ recordUrlTo path "https://github.com/b/second.git"+ recordUrlTo path "https://github.com/a/first.git"+ h <- readHistoryFrom path+ length h.entries `shouldBe` 2+ (head h.entries).url `shouldBe` "https://github.com/a/first.git"++ it "caps history at maxHistoryEntries" $ do+ withSystemTempDirectory "history-test" $ \tmp -> do+ let path = tmp </> "history.json"+ mapM_+ (\i -> recordUrlTo path ("https://example.com/repo-" <> T.pack (show i) <> ".git"))+ [1 .. maxHistoryEntries + 5 :: Int]+ h <- readHistoryFrom path+ length h.entries `shouldBe` maxHistoryEntries
+ test/Seihou/CLI/ListSpec.hs view
@@ -0,0 +1,267 @@+module Seihou.CLI.ListSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.CLI.List (Entry (..), ListFilter (..), applyFilters, formatListOutput, formatListOutputEntries, runnableToEntryWithOrigin)+import Seihou.Core.Module (DiscoveredModule (..), DiscoveredRunnable (..), ModuleSource (..), RunnableKind (..))+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.List" spec++-- | A valid discovered module for testing.+validModule :: String -> String -> ModuleSource -> DiscoveredModule+validModule name desc src =+ DiscoveredModule+ { discoveredResult =+ Right+ Module+ { name = ModuleName (T.pack name),+ version = Nothing,+ description = Just (T.pack desc),+ vars = [],+ exports = [],+ prompts = [],+ steps = [],+ commands = [],+ dependencies = [],+ removal = Nothing,+ migrations = []+ },+ discoveredSource = src,+ discoveredDir = "/fake/" ++ name+ }++-- | A broken discovered module for testing.+brokenModule :: String -> ModuleSource -> DiscoveredModule+brokenModule name src =+ DiscoveredModule+ { discoveredResult = Left (DhallEvalError (ModuleName (T.pack name)) "parse error"),+ discoveredSource = src,+ discoveredDir = "/fake/" ++ name+ }++-- | Helper to build an Entry for filter tests. Defaults the kind to a module.+mkEntry :: T.Text -> Maybe T.Text -> [T.Text] -> Entry+mkEntry = mkEntryK KindModule++-- | Helper to build an Entry with an explicit kind for kind-filter tests.+mkEntryK :: RunnableKind -> T.Text -> Maybe T.Text -> [T.Text] -> Entry+mkEntryK kind name repo tags =+ Entry+ { entryName = name,+ entryDesc = "desc",+ entrySource = "installed",+ entryIsError = False,+ entryRepoName = repo,+ entryTags = tags,+ entryKind = kind+ }++noFilter :: ListFilter+noFilter = ListFilter Nothing Nothing []++spec :: Spec+spec = do+ describe "formatListOutput" $ do+ it "shows no-items message when list is empty" $ do+ let result = formatListOutput False [] ["path1", "path2"]+ T.isInfixOf "No items found." result `shouldBe` True+ T.isInfixOf "path1" result `shouldBe` True+ T.isInfixOf "path2" result `shouldBe` True++ it "shows available modules header" $ do+ let mods = [validModule "test-mod" "A test module" SourceUser]+ result = formatListOutput False mods ["p1", "p2", "p3"]+ T.isInfixOf "Available modules, recipes, blueprints, and prompts:" result `shouldBe` True++ it "shows module name and description" $ do+ let mods = [validModule "haskell-base" "Haskell boilerplate" SourceUser]+ result = formatListOutput False mods ["p1"]+ T.isInfixOf "haskell-base" result `shouldBe` True+ T.isInfixOf "Haskell boilerplate" result `shouldBe` True++ it "shows source tag in parentheses" $ do+ let mods = [validModule "my-mod" "desc" SourceInstalled]+ result = formatListOutput False mods ["p1"]+ T.isInfixOf "(installed)" result `shouldBe` True++ it "shows error indicator for failed modules" $ do+ let mods = [brokenModule "broken-mod" SourceUser]+ result = formatListOutput False mods ["p1"]+ T.isInfixOf "[error:" result `shouldBe` True+ T.isInfixOf "broken-mod" result `shouldBe` True++ it "shows count summary" $ do+ let mods =+ [ validModule "mod-a" "desc a" SourceProject,+ validModule "mod-b" "desc b" SourceInstalled+ ]+ result = formatListOutput False mods ["p1", "p2", "p3"]+ T.isInfixOf "2 modules found" result `shouldBe` True+ T.isInfixOf "3 sources searched" result `shouldBe` True++ it "shows singular noun for one module" $ do+ let mods = [validModule "only-one" "desc" SourceUser]+ result = formatListOutput False mods ["p1"]+ T.isInfixOf "1 module found" result `shouldBe` True++ describe "applyFilters" $ do+ let entries =+ [ mkEntry "mod-a" (Just "repo-x") ["haskell", "cli"],+ mkEntry "mod-b" (Just "repo-x") ["python"],+ mkEntry "mod-c" (Just "repo-y") ["haskell"],+ mkEntry "mod-d" Nothing []+ ]++ it "returns all entries with no filters" $ do+ let result = applyFilters noFilter entries+ length result `shouldBe` 4++ it "filters by repo name" $ do+ let opts = ListFilter (Just "repo-x") Nothing []+ result = applyFilters opts entries+ length result `shouldBe` 2+ map (.entryName) result `shouldBe` ["mod-a", "mod-b"]++ it "filters by tag" $ do+ let opts = ListFilter Nothing (Just "haskell") []+ result = applyFilters opts entries+ length result `shouldBe` 2+ map (.entryName) result `shouldBe` ["mod-a", "mod-c"]++ it "combines repo and tag filters with AND" $ do+ let opts = ListFilter (Just "repo-x") (Just "haskell") []+ result = applyFilters opts entries+ length result `shouldBe` 1+ map (.entryName) result `shouldBe` ["mod-a"]++ it "returns empty list when repo filter matches nothing" $ do+ let opts = ListFilter (Just "nonexistent") Nothing []+ result = applyFilters opts entries+ result `shouldBe` []++ it "returns empty list when tag filter matches nothing" $ do+ let opts = ListFilter Nothing (Just "ruby") []+ result = applyFilters opts entries+ result `shouldBe` []++ it "excludes modules without origin metadata when repo filter is active" $ do+ let opts = ListFilter (Just "repo-x") Nothing []+ result = applyFilters opts entries+ all (\e -> e.entryRepoName == Just "repo-x") result `shouldBe` True++ describe "applyFilters (by kind)" $ do+ let mixed =+ [ mkEntryK KindModule "mod-a" Nothing [],+ mkEntryK KindRecipe "rec-a" Nothing [],+ mkEntryK KindBlueprint "bp-a" Nothing [],+ mkEntryK KindPrompt "prompt-a" Nothing [],+ mkEntryK KindModule "mod-b" (Just "repo-x") ["haskell"]+ ]++ it "keeps all kinds when filterKinds is empty" $ do+ length (applyFilters (ListFilter Nothing Nothing []) mixed) `shouldBe` 5++ it "keeps only modules with --modules" $ do+ let result = applyFilters (ListFilter Nothing Nothing [KindModule]) mixed+ map (.entryName) result `shouldBe` ["mod-a", "mod-b"]++ it "keeps only recipes with --recipes" $ do+ let result = applyFilters (ListFilter Nothing Nothing [KindRecipe]) mixed+ map (.entryName) result `shouldBe` ["rec-a"]++ it "keeps only blueprints with --blueprints" $ do+ let result = applyFilters (ListFilter Nothing Nothing [KindBlueprint]) mixed+ map (.entryName) result `shouldBe` ["bp-a"]++ it "keeps only prompts with --prompts" $ do+ let result = applyFilters (ListFilter Nothing Nothing [KindPrompt]) mixed+ map (.entryName) result `shouldBe` ["prompt-a"]++ it "unions kinds when several flags are given" $ do+ let result = applyFilters (ListFilter Nothing Nothing [KindModule, KindRecipe]) mixed+ map (.entryName) result `shouldBe` ["mod-a", "rec-a", "mod-b"]++ it "combines kind and repo with AND" $ do+ let result = applyFilters (ListFilter (Just "repo-x") Nothing [KindModule]) mixed+ map (.entryName) result `shouldBe` ["mod-b"]++ it "returns empty when kind matches nothing in the set" $ do+ let onlyRecipes = filter (\e -> e.entryKind == KindRecipe) mixed+ result = applyFilters (ListFilter Nothing Nothing [KindBlueprint]) onlyRecipes+ result `shouldBe` []++ describe "formatListOutputEntries (count noun)" $ do+ let noFilterF = ListFilter Nothing Nothing []++ it "uses the kind noun when all shown entries share one kind" $ do+ let entries = [mkEntryK KindBlueprint "bp-a" Nothing [], mkEntryK KindBlueprint "bp-b" Nothing []]+ result = formatListOutputEntries False entries ["p1"] noFilterF+ T.isInfixOf "2 blueprints found" result `shouldBe` True++ it "uses the singular kind noun for one entry" $ do+ let entries = [mkEntryK KindRecipe "rec-a" Nothing []]+ result = formatListOutputEntries False entries ["p1"] noFilterF+ T.isInfixOf "1 recipe found" result `shouldBe` True++ it "uses the prompt noun when all shown entries are prompts" $ do+ let entries = [mkEntryK KindPrompt "review" Nothing [], mkEntryK KindPrompt "explain" Nothing []]+ result = formatListOutputEntries False entries ["p1"] noFilterF+ T.isInfixOf "2 prompts found" result `shouldBe` True++ it "falls back to the neutral noun for a mix of kinds" $ do+ let entries = [mkEntryK KindModule "mod-a" Nothing [], mkEntryK KindRecipe "rec-a" Nothing []]+ result = formatListOutputEntries False entries ["p1"] noFilterF+ T.isInfixOf "2 items found" result `shouldBe` True++ it "names the kind in the empty message when filtered to one kind" $ do+ let result = formatListOutputEntries False [] ["p1"] (ListFilter Nothing Nothing [KindBlueprint])+ T.isInfixOf "No blueprints found." result `shouldBe` True++ it "names prompts in the empty message when filtered to prompts" $ do+ let result = formatListOutputEntries False [] ["p1"] (ListFilter Nothing Nothing [KindPrompt])+ T.isInfixOf "No prompts found." result `shouldBe` True++ it "uses the neutral noun in the empty message with no kind filter" $ do+ let result = formatListOutputEntries False [] ["p1"] noFilterF+ T.isInfixOf "No items found." result `shouldBe` True++ describe "runnableToEntryWithOrigin (blueprint)" $ do+ it "tags blueprint entries with [blueprint] in the source label" $ do+ let dr =+ DiscoveredRunnable+ { drName = "demo",+ drDescription = Just "A new seihou blueprint",+ drKind = KindBlueprint,+ drSource = SourceProject,+ drDir = "/fake/demo",+ drIsError = False,+ drError = Nothing+ }+ entry = runnableToEntryWithOrigin Map.empty dr+ entry.entrySource `shouldBe` "project [blueprint]"+ entry.entryName `shouldBe` "demo"+ entry.entryIsError `shouldBe` False+ entry.entryKind `shouldBe` KindBlueprint++ describe "runnableToEntryWithOrigin (prompt)" $ do+ it "tags prompt entries with [prompt] in the source label" $ do+ let dr =+ DiscoveredRunnable+ { drName = "review",+ drDescription = Just "Review current changes",+ drKind = KindPrompt,+ drSource = SourceProject,+ drDir = "/fake/review",+ drIsError = False,+ drError = Nothing+ }+ entry = runnableToEntryWithOrigin Map.empty dr+ entry.entrySource `shouldBe` "project [prompt]"+ entry.entryName `shouldBe` "review"+ entry.entryIsError `shouldBe` False+ entry.entryKind `shouldBe` KindPrompt
+ test/Seihou/CLI/MigrateSpec.hs view
@@ -0,0 +1,768 @@+module Seihou.CLI.MigrateSpec (tests) where++import Control.Exception (bracket_)+import Data.Aeson (encode, object, (.=))+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful (runEff)+import Seihou.CLI.Migrate+ ( MigrateError (..),+ MigrateOpts (..),+ MigrateResult (..),+ commitMigratedFiles,+ runMigrate,+ )+import Seihou.Core.Migration (MigrationPlan (..))+import Seihou.Core.Types+ ( AppliedModule (..),+ FileRecord (..),+ Manifest (..),+ ModuleName (..),+ Strategy (..),+ emptyParentVars,+ )+import Seihou.Core.Version (renderVersion)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.ManifestStore (writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Engine.Migrate (ExecutedMigrationPlan (..))+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types (emptyManifest)+import System.Directory (createDirectoryIfMissing, doesFileExist, withCurrentDirectory)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readProcessWithExitCode)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Migrate" spec++-- ----------------------------------------------------------------------------+-- Fixture helpers+-- ----------------------------------------------------------------------------++modName :: ModuleName+modName = ModuleName "demo"++fixedTime :: UTCTime+fixedTime =+ parseTimeOrError+ True+ defaultTimeLocale+ "%Y-%m-%dT%H:%M:%SZ"+ "2026-04-01T10:00:00Z"++writeInstalledModule :: FilePath -> Text -> Text -> IO ()+writeInstalledModule dir version migrationsLit = do+ createDirectoryIfMissing True dir+ TIO.writeFile (dir </> "module.dhall") body+ where+ body =+ T.unlines+ [ "{ name = \"demo\"",+ ", version = Some \"" <> version <> "\"",+ ", description = None Text",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", exports = [] : List { var : Text, alias : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+ ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+ ", dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } }",+ ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+ ", migrations = " <> migrationsLit,+ "}"+ ]++moveOldToNewLit :: Text+moveOldToNewLit =+ T.unlines+ [ "[ { from = \"1.0.0\"",+ " , to = \"2.0.0\"",+ " , ops =",+ " [ (< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >).MoveFile { src = \"old.txt\", dest = \"new.txt\" }",+ " ]",+ " }",+ "]"+ ]++moveAppToSrcLit :: Text+moveAppToSrcLit =+ T.unlines+ [ "[ { from = \"1.0.0\"",+ " , to = \"2.0.0\"",+ " , ops =",+ " [ (< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >).MoveFile { src = \"app/Main.hs\", dest = \"src/Main.hs\" }",+ " ]",+ " }",+ "]"+ ]++emptyMigrationsLit :: Text+emptyMigrationsLit =+ "[] : List { from : Text, to : Text, ops : List < MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } > }"++mkManifest :: Text -> FilePath -> [(FilePath, Text)] -> Manifest+mkManifest version installedDir entries =+ (emptyManifest fixedTime)+ { modules =+ [ AppliedModule+ { name = modName,+ parentVars = emptyParentVars,+ source = installedDir,+ moduleVersion = Just version,+ appliedAt = fixedTime,+ removal = Nothing+ }+ ],+ files =+ Map.fromList+ [ ( path,+ FileRecord+ { hash = hashContent content,+ moduleName = modName,+ strategy = Template,+ generatedAt = fixedTime+ }+ )+ | (path, content) <- entries+ ]+ }++defaultOpts :: MigrateOpts+defaultOpts =+ MigrateOpts+ { migrateModule = modName,+ migrateTo = Nothing,+ migrateDryRun = False,+ migrateForce = False,+ migrateJson = False,+ migrateVerbose = False,+ migrateNoFetch = True,+ migrateCommit = False,+ migrateCommitMessage = Nothing+ }++-- ----------------------------------------------------------------------------+-- Fetch-path fixture+-- ----------------------------------------------------------------------------++data FetchFixture = FetchFixture+ { modName :: Text,+ remoteDir :: FilePath,+ installedDir :: FilePath,+ projectDir :: FilePath+ }++withFetchFixture :: Text -> Text -> Text -> (FetchFixture -> IO ()) -> IO ()+withFetchFixture installedVer remoteVer migrationsLit action =+ withSystemTempDirectory "seihou-migrate-fetch" $ \tmp -> do+ let xdgHome = tmp </> "xdg"+ remoteDir = tmp </> "remote"+ projectDir = tmp </> "project"+ nameStr = "demo"+ installedDir = xdgHome </> "seihou" </> "installed" </> nameStr+ fix =+ FetchFixture+ { modName = T.pack nameStr,+ remoteDir = remoteDir,+ installedDir = installedDir,+ projectDir = projectDir+ }++ createDirectoryIfMissing True remoteDir+ createDirectoryIfMissing True projectDir+ createDirectoryIfMissing True installedDir++ writeInstalledModule remoteDir remoteVer migrationsLit+ initRemoteRepo remoteDir++ writeInstalledModule installedDir installedVer emptyMigrationsLit+ writeOriginJson installedDir (T.pack remoteDir)++ withSavedEnv "XDG_CONFIG_HOME" (Just xdgHome) $+ withSavedEnv "GIT_ALLOW_PROTOCOL" (Just "file") $+ action fix++initRemoteRepo :: FilePath -> IO ()+initRemoteRepo dir = do+ run "git" ["init", "--quiet", "--initial-branch=main", dir]+ run "git" ["-C", dir, "config", "user.email", "test@example.com"]+ run "git" ["-C", dir, "config", "user.name", "Test"]+ run "git" ["-C", dir, "config", "commit.gpgsign", "false"]+ run "git" ["-C", dir, "add", "."]+ run "git" ["-C", dir, "commit", "--quiet", "--no-verify", "-m", "fixture"]+ where+ run cmd args = do+ (code, _out, err) <- readProcessWithExitCode cmd args ""+ case code of+ ExitSuccess -> pure ()+ ExitFailure n ->+ expectationFailure+ ( cmd+ <> " "+ <> show args+ <> " exited with "+ <> show n+ <> ":\n"+ <> err+ )++initProjectRepo :: FilePath -> IO ()+initProjectRepo dir = do+ run "git" ["init", "--quiet", "--initial-branch=main", dir]+ run "git" ["-C", dir, "config", "user.email", "test@example.com"]+ run "git" ["-C", dir, "config", "user.name", "Test"]+ run "git" ["-C", dir, "config", "commit.gpgsign", "false"]+ run "git" ["-C", dir, "add", "."]+ run "git" ["-C", dir, "commit", "--quiet", "--no-verify", "-m", "baseline"]+ where+ run cmd args = do+ (code, _out, err) <- readProcessWithExitCode cmd args ""+ case code of+ ExitSuccess -> pure ()+ ExitFailure n ->+ expectationFailure+ ( cmd+ <> " "+ <> show args+ <> " exited with "+ <> show n+ <> ":\n"+ <> err+ )++writeOriginJson :: FilePath -> Text -> IO ()+writeOriginJson installedDir sourceUrl = do+ let payload =+ object+ [ "sourceUrl" .= sourceUrl,+ "repoName" .= (Nothing :: Maybe Text),+ "version" .= (Nothing :: Maybe Text)+ ]+ LBS.writeFile (installedDir </> ".seihou-origin.json") (encode payload)++mkManifestAt :: FetchFixture -> Text -> [(FilePath, Text)] -> Manifest+mkManifestAt fix version entries =+ (emptyManifest fixedTime)+ { modules =+ [ AppliedModule+ { name = ModuleName fix.modName,+ parentVars = emptyParentVars,+ source = fix.installedDir,+ moduleVersion = Just version,+ appliedAt = fixedTime,+ removal = Nothing+ }+ ],+ files =+ Map.fromList+ [ ( path,+ FileRecord+ { hash = hashContent content,+ moduleName = ModuleName fix.modName,+ strategy = Template,+ generatedAt = fixedTime+ }+ )+ | (path, content) <- entries+ ]+ }++withSavedEnv :: String -> Maybe String -> IO () -> IO ()+withSavedEnv key newVal action = do+ prev <- lookupEnv key+ let setNew = case newVal of+ Just v -> setEnv key v+ Nothing -> unsetEnv key+ restore = case prev of+ Just v -> setEnv key v+ Nothing -> unsetEnv key+ bracket_ setNew restore action++-- ----------------------------------------------------------------------------+-- Spec+-- ----------------------------------------------------------------------------++spec :: Spec+spec = do+ describe "runMigrate" $ do+ it "errors when the module isn't applied" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "2.0.0" emptyMigrationsLit+ let manifest = (emptyManifest fixedTime) {modules = []}+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Left (MigrateModuleNotApplied n) -> n `shouldBe` modName+ other -> expectationFailure ("expected MigrateModuleNotApplied, got: " <> show other)++ it "errors when the manifest has no recorded version for the module" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "2.0.0" emptyMigrationsLit+ let manifest =+ (emptyManifest fixedTime)+ { modules =+ [ AppliedModule+ { name = modName,+ parentVars = emptyParentVars,+ source = installed,+ moduleVersion = Nothing,+ appliedAt = fixedTime,+ removal = Nothing+ }+ ]+ }+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Left (MigrateNoRecordedVersion n) -> n `shouldBe` modName+ other -> expectationFailure ("expected MigrateNoRecordedVersion, got: " <> show other)++ it "returns MigrateNoOp when manifest version equals installed version" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "1.0.0" emptyMigrationsLit+ let manifest = mkManifest "1.0.0" installed []+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Right (MigrateNoOp _) -> pure ()+ other -> expectationFailure ("expected MigrateNoOp, got: " <> show other)++ it "returns a dry-run plan without touching disk" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "2.0.0" moveAppToSrcLit+ createDirectoryIfMissing True (dir </> "app")+ TIO.writeFile (dir </> "app" </> "Main.hs") "module Main where"+ let manifest = mkManifest "1.0.0" installed [("app/Main.hs", "module Main where")]+ opts = defaultOpts {migrateDryRun = True}+ result <-+ withCurrentDirectory dir $+ runMigrate opts manifest installed+ case result of+ Right (MigrateDryRunOK _plan _from _to) -> do+ doesFileExist (dir </> "app" </> "Main.hs") `shouldReturn` True+ doesFileExist (dir </> "src" </> "Main.hs") `shouldReturn` False+ other -> expectationFailure ("expected MigrateDryRunOK, got: " <> show other)++ it "executes the plan and returns the rewritten manifest" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "2.0.0" moveAppToSrcLit+ createDirectoryIfMissing True (dir </> "app")+ TIO.writeFile (dir </> "app" </> "Main.hs") "module Main where"+ let manifest = mkManifest "1.0.0" installed [("app/Main.hs", "module Main where")]+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Right (MigrateApplied _plan manifest' fromV toV) -> do+ renderVersion fromV `shouldBe` "1.0.0"+ renderVersion toV `shouldBe` "2.0.0"+ Map.member "src/Main.hs" manifest'.files `shouldBe` True+ Map.member "app/Main.hs" manifest'.files `shouldBe` False+ (head manifest'.modules).moduleVersion `shouldBe` Just "2.0.0"+ doesFileExist (dir </> "src" </> "Main.hs") `shouldReturn` True+ doesFileExist (dir </> "app" </> "Main.hs") `shouldReturn` False+ other -> expectationFailure ("expected MigrateApplied, got: " <> show other)++ it "refuses to execute without --force when a tracked file has been modified" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "2.0.0" moveAppToSrcLit+ createDirectoryIfMissing True (dir </> "app")+ TIO.writeFile (dir </> "app" </> "Main.hs") "user-edited"+ let manifest = mkManifest "1.0.0" installed [("app/Main.hs", "original")]+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Left (MigrateExecFailed _) ->+ doesFileExist (dir </> "src" </> "Main.hs") `shouldReturn` False+ other -> expectationFailure ("expected MigrateExecFailed, got: " <> show other)++ it "executes through a conflict when --force is set" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "2.0.0" moveAppToSrcLit+ createDirectoryIfMissing True (dir </> "app")+ TIO.writeFile (dir </> "app" </> "Main.hs") "user-edited"+ let manifest = mkManifest "1.0.0" installed [("app/Main.hs", "original")]+ opts = defaultOpts {migrateForce = True}+ result <-+ withCurrentDirectory dir $+ runMigrate opts manifest installed+ case result of+ Right (MigrateApplied _ manifest' _ _) -> do+ doesFileExist (dir </> "src" </> "Main.hs") `shouldReturn` True+ doesFileExist (dir </> "app" </> "Main.hs") `shouldReturn` False+ Map.member "src/Main.hs" manifest'.files `shouldBe` True+ other -> expectationFailure ("expected MigrateApplied, got: " <> show other)++ -- ------------------------------------------------------------------+ -- Fetch-path tests (EP-2): clone source repo, refresh installed+ -- copy, apply chain in one shot.+ -- ------------------------------------------------------------------+ it "fetches a newer remote, refreshes the installed copy, and applies the chain" $+ withFetchFixture "1.0.0" "2.0.0" moveOldToNewLit $ \fix -> do+ TIO.writeFile (fix.projectDir </> "old.txt") "x"+ let manifest = mkManifestAt fix "1.0.0" [("old.txt", "x")]+ opts = (defaultOpts {migrateNoFetch = False}) {migrateModule = ModuleName fix.modName}+ result <-+ withCurrentDirectory fix.projectDir $+ runMigrate opts manifest fix.installedDir+ case result of+ Right (MigrateApplied _ manifest' _ _) -> do+ doesFileExist (fix.projectDir </> "old.txt") `shouldReturn` False+ doesFileExist (fix.projectDir </> "new.txt") `shouldReturn` True+ case manifest'.modules of+ (am : _) -> am.moduleVersion `shouldBe` Just "2.0.0"+ [] -> expectationFailure "manifest has no modules"+ Map.member "new.txt" manifest'.files `shouldBe` True+ Map.member "old.txt" manifest'.files `shouldBe` False+ installedBody <- TIO.readFile (fix.installedDir </> "module.dhall")+ T.isInfixOf "2.0.0" installedBody `shouldBe` True+ other ->+ expectationFailure ("expected MigrateApplied, got: " <> show other)++ it "is a no-op when the remote and installed versions match" $+ withFetchFixture "1.0.0" "1.0.0" emptyMigrationsLit $ \fix -> do+ let manifest = mkManifestAt fix "1.0.0" []+ opts = (defaultOpts {migrateNoFetch = False}) {migrateModule = ModuleName fix.modName}+ result <-+ withCurrentDirectory fix.projectDir $+ runMigrate opts manifest fix.installedDir+ case result of+ Right (MigrateNoOp _) -> pure ()+ other -> expectationFailure ("expected MigrateNoOp, got: " <> show other)++ it "ignores a newer remote when --no-fetch is set" $+ withFetchFixture "1.0.0" "2.0.0" moveOldToNewLit $ \fix -> do+ let manifest = mkManifestAt fix "1.0.0" []+ opts = (defaultOpts {migrateNoFetch = True}) {migrateModule = ModuleName fix.modName}+ result <-+ withCurrentDirectory fix.projectDir $+ runMigrate opts manifest fix.installedDir+ case result of+ Right (MigrateNoOp _) -> pure ()+ other -> expectationFailure ("expected MigrateNoOp, got: " <> show other)++ it "respects --to to stop at an intermediate version" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ twoStepLit =+ T.unlines+ [ "[ { from = \"1.0.0\"",+ " , to = \"1.5.0\"",+ " , ops =",+ " [ (< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >).MoveFile { src = \"a.txt\", dest = \"b.txt\" }",+ " ]",+ " }",+ ", { from = \"1.5.0\"",+ " , to = \"2.0.0\"",+ " , ops =",+ " [ (< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >).MoveFile { src = \"b.txt\", dest = \"c.txt\" }",+ " ]",+ " }",+ "]"+ ]+ writeInstalledModule installed "2.0.0" twoStepLit+ TIO.writeFile (dir </> "a.txt") "x"+ let manifest = mkManifest "1.0.0" installed [("a.txt", "x")]+ opts = defaultOpts {migrateTo = Just "1.5.0"}+ result <-+ withCurrentDirectory dir $+ runMigrate opts manifest installed+ case result of+ Right (MigrateApplied _ manifest' _ toV) -> do+ renderVersion toV `shouldBe` "1.5.0"+ Map.member "b.txt" manifest'.files `shouldBe` True+ Map.member "c.txt" manifest'.files `shouldBe` False+ (head manifest'.modules).moduleVersion `shouldBe` Just "1.5.0"+ doesFileExist (dir </> "b.txt") `shouldReturn` True+ doesFileExist (dir </> "c.txt") `shouldReturn` False+ other -> expectationFailure ("expected MigrateApplied, got: " <> show other)++ -- ------------------------------------------------------------------+ -- EP-35: gap-tolerant scenarios.+ --+ -- The window walker applies any in-window declared migrations and+ -- always advances the manifest to the supplied target. There are+ -- no "blocked" / "benign" / "bump-through" outcomes — every+ -- non-trivial run yields MigrateApplied.+ -- ------------------------------------------------------------------++ it "Scenario A: applies a partial-cover plan and lands the manifest at the target" $+ -- User's reported scenario shape: manifest at 1.0.0, installed+ -- declares 3.0.0 with one edge {1.0.0 -> 2.0.0}. The walker picks+ -- the edge, the engine runs its ops, and the manifest advances+ -- to 3.0.0 (the supplied target) in one command.+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "3.0.0" moveAppToSrcLit+ createDirectoryIfMissing True (dir </> "app")+ TIO.writeFile (dir </> "app" </> "Main.hs") "module Main where"+ let manifest = mkManifest "1.0.0" installed [("app/Main.hs", "module Main where")]+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Right (MigrateApplied _ manifest' fromV toV) -> do+ renderVersion fromV `shouldBe` "1.0.0"+ renderVersion toV `shouldBe` "3.0.0"+ (head manifest'.modules).moduleVersion `shouldBe` Just "3.0.0"+ Map.member "src/Main.hs" manifest'.files `shouldBe` True+ Map.member "app/Main.hs" manifest'.files `shouldBe` False+ doesFileExist (dir </> "src" </> "Main.hs") `shouldReturn` True+ doesFileExist (dir </> "app" </> "Main.hs") `shouldReturn` False+ other ->+ expectationFailure ("expected MigrateApplied, got: " <> show other)++ it "Scenario B: pure version bump (migrations = []) lands the manifest at the target" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "0.3.0" emptyMigrationsLit+ let manifest = mkManifest "0.1.3" installed []+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Right (MigrateApplied execPlan manifest' _ toV) -> do+ renderVersion toV `shouldBe` "0.3.0"+ null execPlan.planSource.planSteps `shouldBe` True+ (head manifest'.modules).moduleVersion `shouldBe` Just "0.3.0"+ other -> expectationFailure ("expected MigrateApplied (pure bump), got: " <> show other)++ it "Scenario C: orphan-edge entirely outside the window also lands the manifest at target" $+ -- Same outcome as Scenario B from the user's perspective — the+ -- manifest advances, no ops run. The walker silently skips the+ -- out-of-window edge.+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ orphanEdgeLit =+ T.unlines+ [ "[ { from = \"0.5.0\"",+ " , to = \"0.6.0\"",+ " , ops = [] : List < MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >",+ " }",+ "]"+ ]+ writeInstalledModule installed "0.3.0" orphanEdgeLit+ let manifest = mkManifest "0.1.3" installed []+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Right (MigrateApplied execPlan manifest' _ toV) -> do+ renderVersion toV `shouldBe` "0.3.0"+ null execPlan.planSource.planSteps `shouldBe` True+ (head manifest'.modules).moduleVersion `shouldBe` Just "0.3.0"+ other -> expectationFailure ("expected MigrateApplied (orphan-edge skip), got: " <> show other)++ it "User's two-component fixture: 0.2 -> 0.6 with [{0.2->0.3}, {0.5->0.6}]" $+ -- The literal example from the user's prompt: two declared+ -- migrations, two-component versions, manifest skips the gap and+ -- runs both edges in order.+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ twoEdgesLit =+ T.unlines+ [ "[ { from = \"0.2\"",+ " , to = \"0.3\"",+ " , ops =",+ " [ (< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >).MoveFile { src = \"v2.txt\", dest = \"v3.txt\" }",+ " ]",+ " }",+ ", { from = \"0.5\"",+ " , to = \"0.6\"",+ " , ops =",+ " [ (< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >).MoveFile { src = \"v5.txt\", dest = \"v6.txt\" }",+ " ]",+ " }",+ "]"+ ]+ writeInstalledModule installed "0.6" twoEdgesLit+ TIO.writeFile (dir </> "v2.txt") "at-v2"+ TIO.writeFile (dir </> "v5.txt") "at-v5"+ let manifest = mkManifest "0.2" installed [("v2.txt", "at-v2"), ("v5.txt", "at-v5")]+ result <-+ withCurrentDirectory dir $+ runMigrate defaultOpts manifest installed+ case result of+ Right (MigrateApplied execPlan manifest' _ toV) -> do+ renderVersion toV `shouldBe` "0.6"+ length execPlan.planSource.planSteps `shouldBe` 2+ (head manifest'.modules).moduleVersion `shouldBe` Just "0.6"+ doesFileExist (dir </> "v3.txt") `shouldReturn` True+ doesFileExist (dir </> "v6.txt") `shouldReturn` True+ doesFileExist (dir </> "v2.txt") `shouldReturn` False+ doesFileExist (dir </> "v5.txt") `shouldReturn` False+ other -> expectationFailure ("expected MigrateApplied (two-edge), got: " <> show other)++ -- ------------------------------------------------------------------+ -- EP-26: --commit / --commit-message auto-commit flags.+ -- ------------------------------------------------------------------++ it "--commit-message stages moved files plus the manifest into a single git commit" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ manifestPath = ".seihou" </> "manifest.json"+ writeInstalledModule installed "2.0.0" moveAppToSrcLit+ createDirectoryIfMissing True (dir </> "app")+ TIO.writeFile (dir </> "app" </> "Main.hs") "module Main where"+ let manifest = mkManifest "1.0.0" installed [("app/Main.hs", "module Main where")]+ opts =+ defaultOpts+ { migrateCommit = True,+ migrateCommitMessage = Just "chore: migrate"+ }+ withCurrentDirectory dir $ do+ createDirectoryIfMissing True (dir </> ".seihou")+ runEff $+ runFilesystem $+ runManifestStore manifestPath $+ writeManifest manifest+ initProjectRepo dir+ result <- runMigrate opts manifest installed+ case result of+ Right (MigrateApplied plan manifest' _ _) -> do+ runEff $+ runFilesystem $+ runManifestStore manifestPath $+ writeManifest manifest'+ commitMigratedFiles opts manifestPath plan+ (subjectExit, subject, _) <-+ readProcessWithExitCode "git" ["log", "-1", "--pretty=%s"] ""+ subjectExit `shouldBe` ExitSuccess+ T.strip (T.pack subject) `shouldBe` "chore: migrate"+ (_, names, _) <-+ readProcessWithExitCode+ "git"+ ["log", "-1", "--name-only", "--no-renames", "--pretty="]+ ""+ let touched = filter (not . T.null) (T.lines (T.pack names))+ touched `shouldContain` ["app/Main.hs"]+ touched `shouldContain` ["src/Main.hs"]+ touched `shouldContain` [".seihou/manifest.json"]+ other ->+ expectationFailure ("expected MigrateApplied, got: " <> show other)++ it "--commit outside a git repo is a silent no-op (apply still succeeds)" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ manifestPath = ".seihou" </> "manifest.json"+ writeInstalledModule installed "2.0.0" moveAppToSrcLit+ createDirectoryIfMissing True (dir </> "app")+ TIO.writeFile (dir </> "app" </> "Main.hs") "module Main where"+ let manifest = mkManifest "1.0.0" installed [("app/Main.hs", "module Main where")]+ opts = defaultOpts {migrateCommitMessage = Just "chore: migrate"}+ withCurrentDirectory dir $ do+ createDirectoryIfMissing True (dir </> ".seihou")+ result <- runMigrate opts manifest installed+ case result of+ Right (MigrateApplied plan manifest' _ _) -> do+ runEff $+ runFilesystem $+ runManifestStore manifestPath $+ writeManifest manifest'+ commitMigratedFiles opts manifestPath plan+ doesFileExist (dir </> "src" </> "Main.hs") `shouldReturn` True+ doesFileExist (dir </> manifestPath) `shouldReturn` True+ other ->+ expectationFailure ("expected MigrateApplied, got: " <> show other)++ it "--commit on a dry-run path returns a dry-run variant (helper is never invoked)" $+ withSystemTempDirectory "seihou-migrate-cli" $ \dir -> do+ let installed = dir </> "installed-demo"+ writeInstalledModule installed "2.0.0" moveAppToSrcLit+ createDirectoryIfMissing True (dir </> "app")+ TIO.writeFile (dir </> "app" </> "Main.hs") "module Main where"+ let manifest = mkManifest "1.0.0" installed [("app/Main.hs", "module Main where")]+ opts =+ defaultOpts+ { migrateDryRun = True,+ migrateCommit = True,+ migrateCommitMessage = Just "chore: migrate"+ }+ withCurrentDirectory dir $ do+ initProjectRepo dir+ result <- runMigrate opts manifest installed+ case result of+ Right (MigrateDryRunOK {}) -> pure ()+ other ->+ expectationFailure ("expected MigrateDryRunOK, got: " <> show other)+ (_, before, _) <- readProcessWithExitCode "git" ["rev-list", "--count", "HEAD"] ""+ T.strip (T.pack before) `shouldBe` "1"++ -- ------------------------------------------------------------------+ -- EP-27 / EP-35 M5: fetch-vs-local divergence fallback.+ --+ -- When the cloned remote ships fewer applicable migrations than+ -- the locally installed copy, the planner prefers the local plan.+ -- This guards against a remote that has dropped a migration the+ -- user's installed copy still declares.+ -- ------------------------------------------------------------------++ it "fetch fallback: local declares partial chain, clone has empty list -> local wins" $+ let partialLit =+ T.unlines+ [ "[ { from = \"0.1\"",+ " , to = \"0.2\"",+ " , ops =",+ " [ (< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >).MoveFile { src = \"old.txt\", dest = \"new.txt\" }",+ " ]",+ " }",+ "]"+ ]+ in withFetchFixture "0.3" "0.3" emptyMigrationsLit $ \fix -> do+ writeInstalledModule fix.installedDir "0.3" partialLit+ writeOriginJson fix.installedDir (T.pack fix.remoteDir)+ TIO.writeFile (fix.projectDir </> "old.txt") "tracked\n"+ let manifest = mkManifestAt fix "0.1" [("old.txt", "tracked\n")]+ opts = (defaultOpts {migrateNoFetch = False}) {migrateModule = ModuleName fix.modName}+ result <-+ withCurrentDirectory fix.projectDir $+ runMigrate opts manifest fix.installedDir+ case result of+ Right (MigrateApplied execPlan manifest' _ toV) -> do+ renderVersion toV `shouldBe` "0.3"+ length execPlan.planSource.planSteps `shouldBe` 1+ case manifest'.modules of+ (am : _) -> am.moduleVersion `shouldBe` Just "0.3"+ [] -> expectationFailure "manifest has no modules"+ doesFileExist (fix.projectDir </> "new.txt") `shouldReturn` True+ doesFileExist (fix.projectDir </> "old.txt") `shouldReturn` False+ other ->+ expectationFailure+ ("expected MigrateApplied (local fallback), got: " <> show other)++ it "fetch fallback: clone-based plan stands when neither side declares applicable edges" $+ withFetchFixture "0.3" "0.3" emptyMigrationsLit $ \fix -> do+ let manifest = mkManifestAt fix "0.1" []+ opts = (defaultOpts {migrateNoFetch = False}) {migrateModule = ModuleName fix.modName}+ result <-+ withCurrentDirectory fix.projectDir $+ runMigrate opts manifest fix.installedDir+ case result of+ Right (MigrateApplied execPlan manifest' _ toV) -> do+ renderVersion toV `shouldBe` "0.3"+ null execPlan.planSource.planSteps `shouldBe` True+ case manifest'.modules of+ (am : _) -> am.moduleVersion `shouldBe` Just "0.3"+ [] -> expectationFailure "manifest has no modules"+ other ->+ expectationFailure ("expected MigrateApplied (no-op-style bump), got: " <> show other)
+ test/Seihou/CLI/PendingMigrationSpec.hs view
@@ -0,0 +1,311 @@+module Seihou.CLI.PendingMigrationSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Seihou.CLI.Migrate (pendingChainFor)+import Seihou.CLI.PendingMigrations+ ( detectPendingMigrations,+ formatRefusalMessage,+ )+import Seihou.Core.Migration+ ( Migration (..),+ MigrationOp (..),+ MigrationPlan (..),+ )+import Seihou.Core.Types+ ( AppliedModule (..),+ Manifest (..),+ Module (..),+ ModuleName (..),+ emptyParentVars,+ )+import Seihou.Core.Version qualified+import Seihou.Manifest.Types (emptyManifest)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.PendingMigration" spec++fixedTime :: UTCTime+fixedTime =+ parseTimeOrError+ True+ defaultTimeLocale+ "%Y-%m-%dT%H:%M:%SZ"+ "2026-04-01T10:00:00Z"++mkApplied :: Maybe Text -> AppliedModule+mkApplied mver =+ AppliedModule+ { name = ModuleName "demo",+ parentVars = emptyParentVars,+ source = "/installed/demo",+ moduleVersion = mver,+ appliedAt = fixedTime,+ removal = Nothing+ }++mkInstalled :: Maybe Text -> [Migration] -> Module+mkInstalled v migs =+ Module+ { name = ModuleName "demo",+ version = v,+ description = Nothing,+ vars = [],+ exports = [],+ prompts = [],+ steps = [],+ commands = [],+ dependencies = [],+ removal = Nothing,+ migrations = migs+ }++writeInstalledModule :: FilePath -> Text -> Text -> Text -> IO ()+writeInstalledModule dir name version migrationsLit = do+ createDirectoryIfMissing True dir+ TIO.writeFile (dir </> "module.dhall") body+ where+ body =+ T.unlines+ [ "{ name = \"" <> name <> "\"",+ ", version = Some \"" <> version <> "\"",+ ", description = None Text",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", exports = [] : List { var : Text, alias : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+ ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+ ", dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } }",+ ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+ ", migrations = " <> migrationsLit,+ "}"+ ]++moveOldToNewLit :: Text+moveOldToNewLit =+ T.unlines+ [ "[ { from = \"1.0.0\"",+ " , to = \"2.0.0\"",+ " , ops =",+ " [ (< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >).MoveFile { src = \"old.txt\", dest = \"new.txt\" }",+ " ]",+ " }",+ "]"+ ]++emptyMigrationsLit :: Text+emptyMigrationsLit =+ "[] : List { from : Text, to : Text, ops : List < MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } > }"++mkAppliedAt :: Text -> FilePath -> Maybe Text -> AppliedModule+mkAppliedAt name source mver =+ AppliedModule+ { name = ModuleName name,+ parentVars = emptyParentVars,+ source = source,+ moduleVersion = mver,+ appliedAt = fixedTime,+ removal = Nothing+ }++spec :: Spec+spec = do+ describe "pendingChainFor" $ do+ it "returns Nothing when manifest has no recorded version" $ do+ let am = mkApplied Nothing+ installed = mkInstalled (Just "2.0.0") [Migration "1.0.0" "2.0.0" []]+ pendingChainFor am installed `shouldBe` Nothing++ it "returns Nothing when installed has no version" $ do+ let am = mkApplied (Just "1.0.0")+ installed = mkInstalled Nothing []+ pendingChainFor am installed `shouldBe` Nothing++ it "returns Nothing when versions match (no chain)" $ do+ let am = mkApplied (Just "1.0.0")+ installed = mkInstalled (Just "1.0.0") []+ pendingChainFor am installed `shouldBe` Nothing++ it "returns Just plan with full chain when manifest is behind installed" $ do+ let mig = Migration "1.0.0" "2.0.0" [DeleteFile "Setup.hs"]+ am = mkApplied (Just "1.0.0")+ installed = mkInstalled (Just "2.0.0") [mig]+ case pendingChainFor am installed of+ Just plan -> do+ plan.planSteps `shouldBe` [mig]+ plan.planTo `shouldBe` parseV "2.0.0"+ Nothing -> expectationFailure "expected Just plan"++ it "returns Nothing for downgrade (manifest > installed)" $ do+ let am = mkApplied (Just "2.0.0")+ installed = mkInstalled (Just "1.0.0") []+ pendingChainFor am installed `shouldBe` Nothing++ it "returns a partial-cover plan when the chain reaches some intermediate version" $ do+ -- master-plan live-tree fixture: manifest=0.1.0, installed=0.3.0,+ -- edges=[0.1.0 -> 0.2.0]. Under the gap-tolerant walker the plan+ -- always carries the supplied target as planTo, regardless of+ -- whether the steps reach it.+ let am = mkApplied (Just "0.1.0")+ mig = Migration "0.1.0" "0.2.0" [DeleteFile "x"]+ installed = mkInstalled (Just "0.3.0") [mig]+ case pendingChainFor am installed of+ Just plan -> do+ plan.planSteps `shouldBe` [mig]+ plan.planFrom `shouldBe` parseV "0.1.0"+ plan.planTo `shouldBe` parseV "0.3.0"+ Nothing -> expectationFailure "expected Just plan with partial cover"++ it "returns an empty-steps plan when no edge starts at the manifest version" $ do+ let am = mkApplied (Just "0.1.3")+ installed = mkInstalled (Just "0.3.0") []+ case pendingChainFor am installed of+ Just plan -> do+ plan.planSteps `shouldBe` []+ plan.planFrom `shouldBe` parseV "0.1.3"+ plan.planTo `shouldBe` parseV "0.3.0"+ Nothing -> expectationFailure "expected Just plan with empty steps"++ it "[] vs [orphanEdge] both yield empty-steps plans (window walker)" $ do+ -- Under the gap-tolerant walker an orphan edge entirely outside+ -- the [installed, target] window contributes nothing — same plan+ -- shape as no migrations declared at all.+ let am = mkApplied (Just "0.2.0")+ emptyInstalled = mkInstalled (Just "0.3.0") []+ orphanInstalled =+ mkInstalled (Just "0.3.0") [Migration "0.5.0" "0.6.0" []]+ case (pendingChainFor am emptyInstalled, pendingChainFor am orphanInstalled) of+ (Just pEmpty, Just pOrphan) -> do+ pEmpty.planSteps `shouldBe` []+ pOrphan.planSteps `shouldBe` []+ pEmpty.planFrom `shouldBe` pOrphan.planFrom+ pEmpty.planTo `shouldBe` pOrphan.planTo+ other ->+ expectationFailure+ ("expected two Just plans, got: " <> show other)++ describe "detectPendingMigrations" $ do+ it "with Nothing filter, surfaces every applied module's pending plan" $+ withSystemTempDirectory "seihou-pending-detect" $ \dir -> do+ let aDir = dir </> "demo-a"+ bDir = dir </> "demo-b"+ writeInstalledModule aDir "demo-a" "2.0.0" moveOldToNewLit+ writeInstalledModule bDir "demo-b" "2.0.0" moveOldToNewLit+ let manifest =+ (emptyManifest fixedTime)+ { modules =+ [ mkAppliedAt "demo-a" aDir (Just "1.0.0"),+ mkAppliedAt "demo-b" bDir (Just "1.0.0")+ ],+ files = Map.empty+ }+ result <- detectPendingMigrations manifest Nothing+ map fst result `shouldMatchList` [ModuleName "demo-a", ModuleName "demo-b"]++ it "with a Just filter, restricts detection to the named modules" $+ withSystemTempDirectory "seihou-pending-detect" $ \dir -> do+ let aDir = dir </> "demo-a"+ bDir = dir </> "demo-b"+ writeInstalledModule aDir "demo-a" "2.0.0" moveOldToNewLit+ writeInstalledModule bDir "demo-b" "2.0.0" moveOldToNewLit+ let manifest =+ (emptyManifest fixedTime)+ { modules =+ [ mkAppliedAt "demo-a" aDir (Just "1.0.0"),+ mkAppliedAt "demo-b" bDir (Just "1.0.0")+ ],+ files = Map.empty+ }+ result <-+ detectPendingMigrations+ manifest+ (Just (Set.singleton (ModuleName "demo-a")))+ map fst result `shouldBe` [ModuleName "demo-a"]++ it "skips modules whose installed copy has no module.dhall" $+ withSystemTempDirectory "seihou-pending-detect" $ \dir -> do+ let bogus = dir </> "missing-installed"+ let manifest =+ (emptyManifest fixedTime)+ { modules = [mkAppliedAt "demo" bogus (Just "1.0.0")],+ files = Map.empty+ }+ result <- detectPendingMigrations manifest Nothing+ result `shouldBe` []++ it "skips modules with no pending chain (manifest already at installed version)" $+ withSystemTempDirectory "seihou-pending-detect" $ \dir -> do+ let modDir = dir </> "demo"+ writeInstalledModule modDir "demo" "1.0.0" emptyMigrationsLit+ let manifest =+ (emptyManifest fixedTime)+ { modules = [mkAppliedAt "demo" modDir (Just "1.0.0")],+ files = Map.empty+ }+ result <- detectPendingMigrations manifest Nothing+ result `shouldBe` []++ it "with a filter selecting only no-chain modules, returns empty" $+ withSystemTempDirectory "seihou-pending-detect" $ \dir -> do+ let withChain = dir </> "with-chain"+ noChain = dir </> "no-chain"+ writeInstalledModule withChain "with-chain" "2.0.0" moveOldToNewLit+ writeInstalledModule noChain "no-chain" "1.0.0" emptyMigrationsLit+ let manifest =+ (emptyManifest fixedTime)+ { modules =+ [ mkAppliedAt "with-chain" withChain (Just "1.0.0"),+ mkAppliedAt "no-chain" noChain (Just "1.0.0")+ ],+ files = Map.empty+ }+ result <-+ detectPendingMigrations+ manifest+ (Just (Set.singleton (ModuleName "no-chain")))+ result `shouldBe` []++ describe "formatRefusalMessage" $ do+ it "lists each module's plan summary and the actionable next step" $ do+ let plan =+ MigrationPlan+ { planModule = "demo",+ planFrom = parseV "1.0.0",+ planTo = parseV "2.0.0",+ planSteps =+ [Migration "1.0.0" "2.0.0" [DeleteFile "Setup.hs"]]+ }+ msg = formatRefusalMessage [(ModuleName "demo", plan)]+ msg `shouldSatisfy` T.isInfixOf "Pending migrations detected:"+ msg `shouldSatisfy` T.isInfixOf "demo: 1.0.0 -> 2.0.0 (1 step(s))"+ msg `shouldSatisfy` T.isInfixOf "--with-migrations"+ msg `shouldSatisfy` T.isInfixOf "seihou migrate <module>"++ it "reports a 0-step pure version-bump entry without doomed vocabulary" $ do+ let plan =+ MigrationPlan+ { planModule = "demo",+ planFrom = parseV "0.2.0",+ planTo = parseV "0.3.0",+ planSteps = []+ }+ msg = formatRefusalMessage [(ModuleName "demo", plan)]+ msg `shouldSatisfy` T.isInfixOf "demo: 0.2.0 -> 0.3.0 (0 step(s))"+ msg `shouldNotSatisfy` T.isInfixOf "Blocked"+ msg `shouldNotSatisfy` T.isInfixOf "--bump-only"+ msg `shouldNotSatisfy` T.isInfixOf "--bump-blocked"++parseV :: Text -> Seihou.Core.Version.Version+parseV t = case Seihou.Core.Version.parseVersion t of+ Just v -> v+ Nothing -> error ("test fixture: unparseable version " <> T.unpack t)
+ test/Seihou/CLI/PromptRenderSpec.hs view
@@ -0,0 +1,86 @@+module Seihou.CLI.PromptRenderSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.CLI.AgentLaunch (AgentContext (..))+import Seihou.CLI.PromptRender (formatPromptGuidance, renderPromptBody, renderPromptSystemPrompt)+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.PromptRender" $ do+ describe "formatPromptGuidance" $ do+ it "includes guidance whose condition is true and omits false guidance" $ do+ let rendered = formatPromptGuidance resolvedVars sampleGuidance+ rendered `shouldSatisfy` T.isInfixOf "### Haskell repository"+ rendered `shouldSatisfy` T.isInfixOf "Use cabal build all."+ rendered `shouldNotSatisfy` T.isInfixOf "Use npm test."++ it "renders a stable empty message when no guidance is selected" $+ formatPromptGuidance resolvedVars [PromptGuidance "Node" "Use npm test." (Just (ExprEq "repo.kind" (VText "node")))]+ `shouldBe` "(no prompt guidance)"++ describe "renderPromptSystemPrompt" $ do+ it "renders context, prompt identity, selected guidance, and the prompt body" $ do+ let body = renderPromptBody resolvedVars "Review {{project.name}}."+ rendered = renderPromptSystemPrompt sampleContext samplePrompt resolvedVars body (Just "Focus on tests.")+ rendered `shouldSatisfy` T.isInfixOf "## Current Environment"+ rendered `shouldSatisfy` T.isInfixOf "## Prompt Identity"+ rendered `shouldSatisfy` T.isInfixOf "## Reference Files"+ rendered `shouldSatisfy` T.isInfixOf "## Prompt Guidance"+ rendered `shouldSatisfy` T.isInfixOf "Use cabal build all."+ rendered `shouldNotSatisfy` T.isInfixOf "Use npm test."+ rendered `shouldSatisfy` T.isInfixOf "Review seihou."+ rendered `shouldSatisfy` T.isInfixOf "Focus on tests."++sampleContext :: AgentContext+sampleContext =+ AgentContext+ { cwd = "/tmp/project",+ seihouInitialized = True,+ hasManifest = False,+ localModuleDhall = False,+ localModules = [],+ availableModules = []+ }++samplePrompt :: AgentPrompt+samplePrompt =+ AgentPrompt+ { name = "review-guided",+ version = Just "0.1.0",+ description = Just "Review with guidance",+ prompt = "Review {{project.name}}.",+ vars = [projectNameDecl],+ prompts = [],+ commandVars = [repoKindCommand],+ guidance = sampleGuidance,+ files = [BlueprintFile {src = "style.md", description = Just "Style notes"}],+ allowedTools = Nothing,+ tags = ["review"],+ launch = Nothing+ }++sampleGuidance :: [PromptGuidance]+sampleGuidance =+ [ PromptGuidance "Haskell repository" "Use cabal build all." (Just (ExprEq "repo.kind" (VText "haskell"))),+ PromptGuidance "Node repository" "Use npm test." (Just (ExprEq "repo.kind" (VText "node")))+ ]++resolvedVars :: Map.Map VarName ResolvedVar+resolvedVars =+ Map.fromList+ [ ("project.name", ResolvedVar (VText "seihou") FromDefault projectNameDecl),+ ("repo.kind", ResolvedVar (VText "haskell") (FromCommand "detect repo") repoKindDecl)+ ]++projectNameDecl :: VarDecl+projectNameDecl = VarDecl "project.name" VTText Nothing Nothing False Nothing++repoKindDecl :: VarDecl+repoKindDecl = VarDecl "repo.kind" VTText Nothing Nothing False Nothing++repoKindCommand :: CommandVar+repoKindCommand = CommandVar "repo.kind" "echo haskell" Nothing Nothing True (Just 100)
+ test/Seihou/CLI/Registry/SyncSpec.hs view
@@ -0,0 +1,320 @@+{-# LANGUAGE OverloadedStrings #-}++module Seihou.CLI.Registry.SyncSpec (tests) where++import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Registry.Sync+ ( SyncAction (..),+ SyncOutcome (..),+ SyncVersionsOpts (..),+ renderSyncReport,+ runSync,+ )+import Seihou.Core.Registry+ ( Registry (..),+ RegistryEntry (..),+ SyncDiff (..),+ SyncReport (..),+ SyncStatus (..),+ )+import Seihou.Dhall.Eval (evalRegistryFromFile)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Registry.Sync" spec++spec :: Spec+spec = do+ describe "runSync" $ do+ it "rewrites the registry with each module's on-disk version" $ do+ withFixture $ \dir -> do+ outcome <-+ runSync+ SyncVersionsOpts+ { syncVersionsDir = Just dir,+ syncVersionsDryRun = False,+ syncVersionsCheck = False+ }+ case outcome of+ SyncFailure msg ->+ expectationFailure ("expected SyncSuccess, got failure: " <> T.unpack msg)+ SyncSuccess _ action -> action `shouldBe` Wrote+ reloaded <- evalRegistryFromFile (dir </> "seihou-registry.dhall")+ case reloaded of+ Left err -> expectationFailure ("failed to reload: " <> show err)+ Right reg -> do+ map (.version) reg.modules `shouldBe` [Just "2.0.0", Just "2.0.0"]++ it "leaves the file untouched under --dry-run" $ do+ withFixture $ \dir -> do+ before <- TIO.readFile (dir </> "seihou-registry.dhall")+ outcome <-+ runSync+ SyncVersionsOpts+ { syncVersionsDir = Just dir,+ syncVersionsDryRun = True,+ syncVersionsCheck = False+ }+ case outcome of+ SyncSuccess _ WouldWrite -> pure ()+ other -> expectationFailure ("expected WouldWrite, got " <> show other)+ after <- TIO.readFile (dir </> "seihou-registry.dhall")+ after `shouldBe` before++ it "leaves the file untouched and reports drift under --check" $ do+ withFixture $ \dir -> do+ before <- TIO.readFile (dir </> "seihou-registry.dhall")+ outcome <-+ runSync+ SyncVersionsOpts+ { syncVersionsDir = Just dir,+ syncVersionsDryRun = False,+ syncVersionsCheck = True+ }+ case outcome of+ SyncSuccess report Checked -> do+ -- first entry missing, second entry stale+ map (.diffStatus) report.syncDiffs+ `shouldBe` [SyncMissing, SyncStale "2.0.0"]+ other -> expectationFailure ("expected Checked, got " <> show other)+ after <- TIO.readFile (dir </> "seihou-registry.dhall")+ after `shouldBe` before++ it "fails when the target directory has no seihou-registry.dhall" $ do+ withSystemTempDirectory "seihou-sync-empty" $ \dir -> do+ outcome <-+ runSync+ SyncVersionsOpts+ { syncVersionsDir = Just dir,+ syncVersionsDryRun = False,+ syncVersionsCheck = False+ }+ case outcome of+ SyncFailure _ -> pure ()+ SyncSuccess {} -> expectationFailure "expected SyncFailure for empty directory"++ it "rewrites a blueprint entry's on-disk version into the registry" $ do+ withBlueprintFixture $ \dir -> do+ outcome <-+ runSync+ SyncVersionsOpts+ { syncVersionsDir = Just dir,+ syncVersionsDryRun = False,+ syncVersionsCheck = False+ }+ case outcome of+ SyncFailure msg -> expectationFailure ("expected success, got: " <> T.unpack msg)+ SyncSuccess _ action -> action `shouldBe` Wrote+ reloaded <- evalRegistryFromFile (dir </> "seihou-registry.dhall")+ case reloaded of+ Left err -> expectationFailure ("failed to reload: " <> show err)+ Right reg -> map (.version) reg.blueprints `shouldBe` [Just "0.2.0"]++ it "renderSyncReport prefixes blueprint rows with blueprints." $ do+ withBlueprintFixture $ \dir -> do+ outcome <-+ runSync+ SyncVersionsOpts+ { syncVersionsDir = Just dir,+ syncVersionsDryRun = True,+ syncVersionsCheck = False+ }+ case outcome of+ SyncSuccess report _ -> do+ let rendered = renderSyncReport report+ T.isInfixOf "blueprints.payments-service:" rendered `shouldBe` True+ other -> expectationFailure ("expected SyncSuccess, got " <> show other)++ it "rewrites a prompt entry's on-disk version into the registry" $ do+ withPromptFixture $ \dir -> do+ outcome <-+ runSync+ SyncVersionsOpts+ { syncVersionsDir = Just dir,+ syncVersionsDryRun = False,+ syncVersionsCheck = False+ }+ case outcome of+ SyncFailure msg -> expectationFailure ("expected success, got: " <> T.unpack msg)+ SyncSuccess _ action -> action `shouldBe` Wrote+ reloaded <- evalRegistryFromFile (dir </> "seihou-registry.dhall")+ case reloaded of+ Left err -> expectationFailure ("failed to reload: " <> show err)+ Right reg -> map (.version) reg.prompts `shouldBe` [Just "0.2.0"]++ it "renderSyncReport prefixes prompt rows with prompts." $ do+ withPromptFixture $ \dir -> do+ outcome <-+ runSync+ SyncVersionsOpts+ { syncVersionsDir = Just dir,+ syncVersionsDryRun = True,+ syncVersionsCheck = False+ }+ case outcome of+ SyncSuccess report _ -> do+ let rendered = renderSyncReport report+ T.isInfixOf "prompts.review-changes:" rendered `shouldBe` True+ other -> expectationFailure ("expected SyncSuccess, got " <> show other)++-- | Build a temp registry repo with:+--+-- * modules/alpha/module.dhall declaring version = Some "2.0.0"+-- * modules/beta/module.dhall declaring version = Some "2.0.0"+-- * seihou-registry.dhall listing both, with the first unversioned and the+-- second stuck at an old "1.0.0"+withFixture :: (FilePath -> IO ()) -> IO ()+withFixture action = withSystemTempDirectory "seihou-sync-fixture" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "alpha")+ createDirectoryIfMissing True (dir </> "modules" </> "beta")+ writeModuleDhall (dir </> "modules" </> "alpha" </> "module.dhall") "alpha" "2.0.0"+ writeModuleDhall (dir </> "modules" </> "beta" </> "module.dhall") "beta" "2.0.0"+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryDhall "alpha" Nothing "beta" (Just "1.0.0"))+ action dir++-- | Build a temp registry repo with a single blueprint entry whose+-- on-disk @blueprint.dhall@ declares @version = "0.2.0"@ but the+-- @seihou-registry.dhall@ pins @"0.1.0"@.+withBlueprintFixture :: (FilePath -> IO ()) -> IO ()+withBlueprintFixture action = withSystemTempDirectory "seihou-sync-bp" $ \dir -> do+ createDirectoryIfMissing True (dir </> "blueprints" </> "payments-service")+ writeBlueprintDhall (dir </> "blueprints" </> "payments-service" </> "blueprint.dhall") "payments-service" "0.2.0"+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryWithBlueprint "payments-service" (Just "0.1.0"))+ action dir++-- | Build a temp registry repo with a single prompt entry whose on-disk+-- @prompt.dhall@ declares @version = "0.2.0"@ but the registry pins @"0.1.0"@.+withPromptFixture :: (FilePath -> IO ()) -> IO ()+withPromptFixture action = withSystemTempDirectory "seihou-sync-prompt" $ \dir -> do+ createDirectoryIfMissing True (dir </> "prompts" </> "review-changes")+ writePromptDhall (dir </> "prompts" </> "review-changes" </> "prompt.dhall") "review-changes" "0.2.0"+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryWithPrompt "review-changes" (Just "0.1.0"))+ action dir++writeBlueprintDhall :: FilePath -> Text -> Text -> IO ()+writeBlueprintDhall path name ver =+ TIO.writeFile+ path+ ( T.unlines+ [ "{ name = \"" <> name <> "\"",+ ", version = Some \"" <> ver <> "\"",+ ", description = None Text",+ ", prompt = \"hi\"",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", baseModules = [] : List { module : Text, vars : List { name : Text, value : Text } }",+ ", files = [] : List { src : Text, description : Optional Text }",+ ", allowedTools = None (List Text)",+ ", tags = [] : List Text",+ "}"+ ]+ )++registryWithBlueprint :: Text -> Maybe Text -> Text+registryWithBlueprint n v =+ T.unlines+ [ "{ repoName = \"Test\"",+ ", repoDescription = None Text",+ ", modules = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+ ", recipes = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+ ", blueprints =",+ " [ { name = \"" <> n <> "\"",+ " , version = " <> optVersion v,+ " , path = \"blueprints/" <> n <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " ]",+ "}"+ ]++writePromptDhall :: FilePath -> Text -> Text -> IO ()+writePromptDhall path name ver =+ TIO.writeFile+ path+ ( T.unlines+ [ "{ name = \"" <> name <> "\"",+ ", version = Some \"" <> ver <> "\"",+ ", description = None Text",+ ", prompt = \"Review the current changes.\"",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", commandVars = [] : List { name : Text, run : Text, workDir : Optional Text, when : Optional Text, trim : Bool, maxBytes : Optional Natural }",+ ", files = [] : List { src : Text, description : Optional Text }",+ ", allowedTools = None (List Text)",+ ", tags = [] : List Text",+ ", launch = None { provider : Optional Text, mode : Optional Text, model : Optional Text }",+ "}"+ ]+ )++registryWithPrompt :: Text -> Maybe Text -> Text+registryWithPrompt n v =+ T.unlines+ [ "{ repoName = \"Test\"",+ ", repoDescription = None Text",+ ", modules = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+ ", recipes = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+ ", blueprints = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+ ", prompts =",+ " [ { name = \"" <> n <> "\"",+ " , version = " <> optVersion v,+ " , path = \"prompts/" <> n <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " ]",+ "}"+ ]++writeModuleDhall :: FilePath -> Text -> Text -> IO ()+writeModuleDhall path name ver =+ TIO.writeFile+ path+ ( T.unlines+ [ "{ name = \"" <> name <> "\"",+ ", version = Some \"" <> ver <> "\"",+ ", description = None Text",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", exports = [] : List { var : Text, alias : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+ ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+ ", dependencies = [] : List Text",+ ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+ "}"+ ]+ )++registryDhall :: Text -> Maybe Text -> Text -> Maybe Text -> Text+registryDhall n1 v1 n2 v2 =+ T.unlines+ [ "{ repoName = \"Test\"",+ ", repoDescription = None Text",+ ", modules =",+ " [ { name = \"" <> n1 <> "\"",+ " , version = " <> optVersion v1,+ " , path = \"modules/" <> n1 <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " , { name = \"" <> n2 <> "\"",+ " , version = " <> optVersion v2,+ " , path = \"modules/" <> n2 <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " ]",+ "}"+ ]++optVersion :: Maybe Text -> Text+optVersion Nothing = "None Text"+optVersion (Just v) = "Some \"" <> v <> "\""
+ test/Seihou/CLI/Registry/ValidateSpec.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE OverloadedStrings #-}++module Seihou.CLI.Registry.ValidateSpec (tests) where++import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Registry.Validate+ ( ValidateOutcome (..),+ ValidateRegistryOpts (..),+ renderValidationReport,+ runValidate,+ )+import Seihou.Core.Registry+ ( RegistryValidationIssue (..),+ RegistryValidationReport (..),+ SyncDiff (..),+ SyncStatus (..),+ )+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Registry.Validate" spec++spec :: Spec+spec = do+ describe "runValidate" $ do+ it "succeeds with no issues for a clean registry" $ do+ withCleanFixture $ \dir -> do+ outcome <- runValidate (ValidateRegistryOpts (Just dir))+ case outcome of+ ValidateOk r -> do+ r.reportIssues `shouldBe` []+ r.reportModuleCount `shouldBe` 2+ r.reportRecipeCount `shouldBe` 0+ other -> expectationFailure ("expected ValidateOk, got " <> show other)++ it "flags both stale and missing version entries" $ do+ withDriftedFixture $ \dir -> do+ outcome <- runValidate (ValidateRegistryOpts (Just dir))+ case outcome of+ ValidateOk r -> do+ let statuses =+ [ d.diffStatus+ | VersionMismatch d <- r.reportIssues+ ]+ statuses `shouldBe` [SyncMissing, SyncStale "2.0.0"]+ other -> expectationFailure ("unexpected outcome: " <> show other)++ it "flags structural issues alongside version issues" $ do+ withMissingFileFixture $ \dir -> do+ outcome <- runValidate (ValidateRegistryOpts (Just dir))+ case outcome of+ ValidateOk r -> do+ let structurals =+ [ msg+ | StructuralError msg <- r.reportIssues+ ]+ any ("missing module.dhall" `T.isInfixOf`) structurals+ `shouldBe` True+ other -> expectationFailure ("unexpected outcome: " <> show other)++ it "fails when there is no registry at the target directory" $ do+ withSystemTempDirectory "seihou-validate-empty" $ \dir -> do+ outcome <- runValidate (ValidateRegistryOpts (Just dir))+ case outcome of+ ValidateFailed _ -> pure ()+ ValidateOk _ ->+ expectationFailure "expected ValidateFailed for empty directory"++ it "flags blueprint version drift with the blueprints. prefix" $ do+ withDriftedBlueprintFixture $ \dir -> do+ outcome <- runValidate (ValidateRegistryOpts (Just dir))+ case outcome of+ ValidateOk r -> do+ let rendered = renderValidationReport r+ T.isInfixOf "blueprints.payments-service:" rendered `shouldBe` True+ other -> expectationFailure ("unexpected outcome: " <> show other)++ it "renders the success summary with module, recipe, and blueprint counts" $ do+ withCleanBlueprintFixture $ \dir -> do+ outcome <- runValidate (ValidateRegistryOpts (Just dir))+ case outcome of+ ValidateOk r -> do+ let rendered = renderValidationReport r+ T.isInfixOf "1 module" rendered `shouldBe` True+ T.isInfixOf "0 recipes" rendered `shouldBe` True+ T.isInfixOf "1 blueprint" rendered `shouldBe` True+ T.isInfixOf "0 prompts" rendered `shouldBe` True+ T.isInfixOf "all versions in sync" rendered `shouldBe` True+ other -> expectationFailure ("unexpected outcome: " <> show other)++ it "flags prompt version drift with the prompts. prefix" $ do+ withDriftedPromptFixture $ \dir -> do+ outcome <- runValidate (ValidateRegistryOpts (Just dir))+ case outcome of+ ValidateOk r -> do+ let rendered = renderValidationReport r+ T.isInfixOf "prompts.review-changes:" rendered `shouldBe` True+ other -> expectationFailure ("unexpected outcome: " <> show other)++ it "renders prompt counts in the success summary" $ do+ withCleanPromptFixture $ \dir -> do+ outcome <- runValidate (ValidateRegistryOpts (Just dir))+ case outcome of+ ValidateOk r -> do+ let rendered = renderValidationReport r+ T.isInfixOf "0 modules" rendered `shouldBe` True+ T.isInfixOf "0 recipes" rendered `shouldBe` True+ T.isInfixOf "0 blueprints" rendered `shouldBe` True+ T.isInfixOf "1 prompt" rendered `shouldBe` True+ T.isInfixOf "all versions in sync" rendered `shouldBe` True+ other -> expectationFailure ("unexpected outcome: " <> show other)++-- | Two modules at version 1.0.0, registry lists both at version 1.0.0.+withCleanFixture :: (FilePath -> IO ()) -> IO ()+withCleanFixture action = withSystemTempDirectory "seihou-validate-clean" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "alpha")+ createDirectoryIfMissing True (dir </> "modules" </> "beta")+ writeModuleDhall (dir </> "modules" </> "alpha" </> "module.dhall") "alpha" "1.0.0"+ writeModuleDhall (dir </> "modules" </> "beta" </> "module.dhall") "beta" "1.0.0"+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryDhall "alpha" (Just "1.0.0") "beta" (Just "1.0.0"))+ action dir++-- | Two modules on disk at 2.0.0; registry lists alpha unversioned and+-- beta stuck at 1.0.0 — produces SyncMissing then SyncStale "2.0.0".+withDriftedFixture :: (FilePath -> IO ()) -> IO ()+withDriftedFixture action = withSystemTempDirectory "seihou-validate-drift" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "alpha")+ createDirectoryIfMissing True (dir </> "modules" </> "beta")+ writeModuleDhall (dir </> "modules" </> "alpha" </> "module.dhall") "alpha" "2.0.0"+ writeModuleDhall (dir </> "modules" </> "beta" </> "module.dhall") "beta" "2.0.0"+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryDhall "alpha" Nothing "beta" (Just "1.0.0"))+ action dir++-- | One real module + one entry whose path points at a directory with no+-- module.dhall. Produces a "missing module.dhall" structural error.+withMissingFileFixture :: (FilePath -> IO ()) -> IO ()+withMissingFileFixture action = withSystemTempDirectory "seihou-validate-missing" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "alpha")+ writeModuleDhall (dir </> "modules" </> "alpha" </> "module.dhall") "alpha" "1.0.0"+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryDhall "alpha" (Just "1.0.0") "ghost" Nothing)+ action dir++-- | One module + one drifted blueprint. Module's registry version+-- matches its on-disk version (no module drift); the blueprint's+-- registry version is "0.1.0" while its on-disk version is "0.2.0".+withDriftedBlueprintFixture :: (FilePath -> IO ()) -> IO ()+withDriftedBlueprintFixture action = withSystemTempDirectory "seihou-validate-bp-drift" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "alpha")+ writeModuleDhall (dir </> "modules" </> "alpha" </> "module.dhall") "alpha" "1.0.0"+ createDirectoryIfMissing True (dir </> "blueprints" </> "payments-service")+ writeBlueprintDhall (dir </> "blueprints" </> "payments-service" </> "blueprint.dhall") "payments-service" "0.2.0"+ TIO.writeFile+ (dir </> "seihou-registry.dhall")+ (mixedRegistry "alpha" (Just "1.0.0") "payments-service" (Just "0.1.0"))+ action dir++-- | One module + one blueprint, all versions matching on disk and in+-- the registry.+withCleanBlueprintFixture :: (FilePath -> IO ()) -> IO ()+withCleanBlueprintFixture action = withSystemTempDirectory "seihou-validate-bp-clean" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "alpha")+ writeModuleDhall (dir </> "modules" </> "alpha" </> "module.dhall") "alpha" "1.0.0"+ createDirectoryIfMissing True (dir </> "blueprints" </> "payments-service")+ writeBlueprintDhall (dir </> "blueprints" </> "payments-service" </> "blueprint.dhall") "payments-service" "0.1.0"+ TIO.writeFile+ (dir </> "seihou-registry.dhall")+ (mixedRegistry "alpha" (Just "1.0.0") "payments-service" (Just "0.1.0"))+ action dir++-- | One prompt whose registry version is stale relative to prompt.dhall.+withDriftedPromptFixture :: (FilePath -> IO ()) -> IO ()+withDriftedPromptFixture action = withSystemTempDirectory "seihou-validate-prompt-drift" $ \dir -> do+ createDirectoryIfMissing True (dir </> "prompts" </> "review-changes")+ writePromptDhall (dir </> "prompts" </> "review-changes" </> "prompt.dhall") "review-changes" "0.2.0"+ TIO.writeFile+ (dir </> "seihou-registry.dhall")+ (promptRegistry "review-changes" (Just "0.1.0"))+ action dir++-- | One prompt, all versions matching on disk and in the registry.+withCleanPromptFixture :: (FilePath -> IO ()) -> IO ()+withCleanPromptFixture action = withSystemTempDirectory "seihou-validate-prompt-clean" $ \dir -> do+ createDirectoryIfMissing True (dir </> "prompts" </> "review-changes")+ writePromptDhall (dir </> "prompts" </> "review-changes" </> "prompt.dhall") "review-changes" "0.2.0"+ TIO.writeFile+ (dir </> "seihou-registry.dhall")+ (promptRegistry "review-changes" (Just "0.2.0"))+ action dir++writeBlueprintDhall :: FilePath -> Text -> Text -> IO ()+writeBlueprintDhall path name ver =+ TIO.writeFile+ path+ ( T.unlines+ [ "{ name = \"" <> name <> "\"",+ ", version = Some \"" <> ver <> "\"",+ ", description = None Text",+ ", prompt = \"hi\"",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", baseModules = [] : List { module : Text, vars : List { name : Text, value : Text } }",+ ", files = [] : List { src : Text, description : Optional Text }",+ ", allowedTools = None (List Text)",+ ", tags = [] : List Text",+ "}"+ ]+ )++mixedRegistry :: Text -> Maybe Text -> Text -> Maybe Text -> Text+mixedRegistry modName modVer bpName bpVer =+ T.unlines+ [ "{ repoName = \"Mixed\"",+ ", repoDescription = None Text",+ ", modules =",+ " [ { name = \"" <> modName <> "\"",+ " , version = " <> optVersion modVer,+ " , path = \"modules/" <> modName <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " ]",+ ", blueprints =",+ " [ { name = \"" <> bpName <> "\"",+ " , version = " <> optVersion bpVer,+ " , path = \"blueprints/" <> bpName <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " ]",+ "}"+ ]++writePromptDhall :: FilePath -> Text -> Text -> IO ()+writePromptDhall path name ver =+ TIO.writeFile+ path+ ( T.unlines+ [ "{ name = \"" <> name <> "\"",+ ", version = Some \"" <> ver <> "\"",+ ", description = None Text",+ ", prompt = \"Review the current changes.\"",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", commandVars = [] : List { name : Text, run : Text, workDir : Optional Text, when : Optional Text, trim : Bool, maxBytes : Optional Natural }",+ ", files = [] : List { src : Text, description : Optional Text }",+ ", allowedTools = None (List Text)",+ ", tags = [] : List Text",+ ", launch = None { provider : Optional Text, mode : Optional Text, model : Optional Text }",+ "}"+ ]+ )++promptRegistry :: Text -> Maybe Text -> Text+promptRegistry promptName promptVer =+ T.unlines+ [ "{ repoName = \"Prompts\"",+ ", repoDescription = None Text",+ ", modules = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+ ", recipes = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+ ", blueprints = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }",+ ", prompts =",+ " [ { name = \"" <> promptName <> "\"",+ " , version = " <> optVersion promptVer,+ " , path = \"prompts/" <> promptName <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " ]",+ "}"+ ]++writeModuleDhall :: FilePath -> Text -> Text -> IO ()+writeModuleDhall path name ver =+ TIO.writeFile+ path+ ( T.unlines+ [ "{ name = \"" <> name <> "\"",+ ", version = Some \"" <> ver <> "\"",+ ", description = None Text",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", exports = [] : List { var : Text, alias : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+ ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+ ", dependencies = [] : List Text",+ ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+ "}"+ ]+ )++registryDhall :: Text -> Maybe Text -> Text -> Maybe Text -> Text+registryDhall n1 v1 n2 v2 =+ T.unlines+ [ "{ repoName = \"Test\"",+ ", repoDescription = None Text",+ ", modules =",+ " [ { name = \"" <> n1 <> "\"",+ " , version = " <> optVersion v1,+ " , path = \"modules/" <> n1 <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " , { name = \"" <> n2 <> "\"",+ " , version = " <> optVersion v2,+ " , path = \"modules/" <> n2 <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " ]",+ "}"+ ]++optVersion :: Maybe Text -> Text+optVersion Nothing = "None Text"+optVersion (Just v) = "Some \"" <> v <> "\""
+ test/Seihou/CLI/RemoteVersionSpec.hs view
@@ -0,0 +1,117 @@+module Seihou.CLI.RemoteVersionSpec (tests) where++import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.RemoteVersion (FetchError (..), fetchTrueModuleVersion)+import Seihou.Core.Types (ModuleName (..))+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.RemoteVersion" spec++spec :: Spec+spec = do+ describe "fetchTrueModuleVersion (multi-module repo)" $ do+ it "returns the module.dhall version even when the registry says otherwise" $+ withSystemTempDirectory "seihou-rv-stale" $ \dir -> do+ -- Stale registry: registry declares 1.0.0, module.dhall declares 2.0.0.+ createDirectoryIfMissing True (dir </> "modules" </> "demo")+ writeModuleDhall (dir </> "modules" </> "demo" </> "module.dhall") "demo" (Just "2.0.0")+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryDhall "demo" (Just "1.0.0") "modules/demo")++ result <- fetchTrueModuleVersion dir (ModuleName "demo")+ result `shouldBe` Right (Just "2.0.0")++ it "returns Right Nothing when module.dhall declares no version" $+ withSystemTempDirectory "seihou-rv-unver" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "demo")+ writeModuleDhall (dir </> "modules" </> "demo" </> "module.dhall") "demo" Nothing+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryDhall "demo" (Just "1.0.0") "modules/demo")++ result <- fetchTrueModuleVersion dir (ModuleName "demo")+ result `shouldBe` Right Nothing++ it "returns EntryNotFound when the registry has no matching module" $+ withSystemTempDirectory "seihou-rv-missing" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "demo")+ writeModuleDhall (dir </> "modules" </> "demo" </> "module.dhall") "demo" (Just "2.0.0")+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryDhall "demo" (Just "1.0.0") "modules/demo")++ result <- fetchTrueModuleVersion dir (ModuleName "other")+ result `shouldBe` Left (EntryNotFound (ModuleName "other"))++ it "returns ModuleDhallNotFound when the registry path doesn't have module.dhall" $+ withSystemTempDirectory "seihou-rv-broken" $ \dir -> do+ createDirectoryIfMissing True (dir </> "modules" </> "demo")+ TIO.writeFile (dir </> "seihou-registry.dhall") (registryDhall "demo" (Just "1.0.0") "modules/demo")++ result <- fetchTrueModuleVersion dir (ModuleName "demo")+ case result of+ Left (ModuleDhallNotFound _) -> pure ()+ other -> expectationFailure ("expected ModuleDhallNotFound, got " <> show other)++ describe "fetchTrueModuleVersion (single-module repo)" $ do+ it "reads module.dhall at the repo root" $+ withSystemTempDirectory "seihou-rv-single" $ \dir -> do+ writeModuleDhall (dir </> "module.dhall") "demo" (Just "3.4.5")++ result <- fetchTrueModuleVersion dir (ModuleName "demo")+ result `shouldBe` Right (Just "3.4.5")++ describe "fetchTrueModuleVersion (empty repo)" $ do+ it "returns RegistryNotFound when nothing recognizable is present" $+ withSystemTempDirectory "seihou-rv-empty" $ \dir -> do+ result <- fetchTrueModuleVersion dir (ModuleName "demo")+ case result of+ Left (RegistryNotFound _) -> pure ()+ other -> expectationFailure ("expected RegistryNotFound, got " <> show other)++-- ----------------------------------------------------------------------------+-- Fixture helpers+-- ----------------------------------------------------------------------------++writeModuleDhall :: FilePath -> Text -> Maybe Text -> IO ()+writeModuleDhall path name mver =+ TIO.writeFile path (moduleDhallBody name mver)++moduleDhallBody :: Text -> Maybe Text -> Text+moduleDhallBody name mver =+ T.unlines+ [ "{ name = \"" <> name <> "\"",+ ", version = " <> optText mver,+ ", description = None Text",+ ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+ ", exports = [] : List { var : Text, alias : Optional Text }",+ ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+ ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+ ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+ ", dependencies = [] : List Text",+ ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+ "}"+ ]++registryDhall :: Text -> Maybe Text -> Text -> Text+registryDhall name mver path =+ T.unlines+ [ "{ repoName = \"Test\"",+ ", repoDescription = None Text",+ ", modules =",+ " [ { name = \"" <> name <> "\"",+ " , version = " <> optText mver,+ " , path = \"" <> path <> "\"",+ " , description = None Text",+ " , tags = [] : List Text",+ " }",+ " ]",+ "}"+ ]++optText :: Maybe Text -> Text+optText Nothing = "None Text"+optText (Just v) = "Some \"" <> v <> "\""
+ test/Seihou/CLI/RunBlueprintRefusalSpec.hs view
@@ -0,0 +1,36 @@+module Seihou.CLI.RunBlueprintRefusalSpec (tests) where++import Data.Text qualified as T+import Seihou.CLI.Shared (formatBlueprintRefusal)+import Seihou.Core.Types (ModuleName (..))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.RunBlueprintRefusal" spec++spec :: Spec+spec = do+ describe "formatBlueprintRefusal" $ do+ it "names the blueprint that was attempted" $ do+ let msg = formatBlueprintRefusal (ModuleName "my-blueprint")+ T.isInfixOf "'my-blueprint' is a blueprint" msg `shouldBe` True++ it "describes that blueprints aren't modules or recipes" $ do+ let msg = formatBlueprintRefusal (ModuleName "x")+ T.isInfixOf "not a module or recipe" msg `shouldBe` True++ it "tells the user how to invoke the blueprint via the agent runner" $ do+ let msg = formatBlueprintRefusal (ModuleName "payments-service")+ T.isInfixOf "seihou agent run payments-service" msg `shouldBe` True++ it "is rendered as a single multi-line string (one '[error]' prefix at runtime)" $ do+ -- The Logger interpreter prefixes each logError call with+ -- "[error] ". The refusal body must therefore be emitted as a+ -- single string with newlines so only the first line carries the+ -- prefix. Verify the message contains newline separators rather+ -- than being a list of independent strings.+ let msg = formatBlueprintRefusal (ModuleName "a")+ lns = T.splitOn "\n" msg+ length lns `shouldBe` 3
+ test/Seihou/CLI/SavePromptedSpec.hs view
@@ -0,0 +1,184 @@+module Seihou.CLI.SavePromptedSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Seihou.CLI.SavePrompted (collectPromptedValues, offerSavePrompted)+import Seihou.Composition.Instance (primaryInstance)+import Seihou.Core.Types+import Seihou.Effect.ConfigWriterPure (ConfigWriterState (..), emptyConfigWriterState, runConfigWriterPure)+import Seihou.Effect.ConsolePure (ConsoleState (..), runConsolePure)+import Seihou.Prelude (runEff)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.SavePrompted" spec++mkDecl :: Text -> VarDecl+mkDecl n =+ VarDecl+ { name = VarName n,+ type_ = VTText,+ default_ = Nothing,+ description = Nothing,+ required = True,+ validation = Nothing+ }++mkResolved :: VarSource -> Text -> VarDecl -> ResolvedVar+mkResolved src val decl =+ ResolvedVar+ { value = VText val,+ source = src,+ decl = decl+ }++spec :: Spec+spec = do+ describe "collectPromptedValues" $ do+ it "extracts variables with FromPrompt source" $ do+ let decl = mkDecl "project.name"+ resolved =+ Map.singleton (primaryInstance (ModuleName "mod1")) $+ Map.singleton (VarName "project.name") (mkResolved FromPrompt "my-app" decl)+ result = collectPromptedValues resolved Map.empty+ result `shouldBe` [(VarName "project.name", "my-app", Nothing)]++ it "ignores variables from non-prompt sources" $ do+ let decl = mkDecl "license"+ resolved =+ Map.singleton (primaryInstance (ModuleName "mod1")) $+ Map.fromList+ [ (VarName "license", mkResolved FromGlobalConfig "MIT" decl),+ (VarName "project.name", mkResolved FromCLI "foo" (mkDecl "project.name"))+ ]+ result = collectPromptedValues resolved Map.empty+ result `shouldBe` []++ it "skips values already in local config with the same value" $ do+ let decl = mkDecl "project.name"+ resolved =+ Map.singleton (primaryInstance (ModuleName "mod1")) $+ Map.singleton (VarName "project.name") (mkResolved FromPrompt "my-app" decl)+ localConfig = Map.singleton (VarName "project.name") "my-app"+ result = collectPromptedValues resolved localConfig+ result `shouldBe` []++ it "includes values that differ from local config with existing value" $ do+ let decl = mkDecl "project.name"+ resolved =+ Map.singleton (primaryInstance (ModuleName "mod1")) $+ Map.singleton (VarName "project.name") (mkResolved FromPrompt "new-app" decl)+ localConfig = Map.singleton (VarName "project.name") "old-app"+ result = collectPromptedValues resolved localConfig+ result `shouldBe` [(VarName "project.name", "new-app", Just "old-app")]++ it "deduplicates across modules" $ do+ let decl = mkDecl "project.name"+ resolved =+ Map.fromList+ [ ( primaryInstance (ModuleName "mod1"),+ Map.singleton (VarName "project.name") (mkResolved FromPrompt "app1" decl)+ ),+ ( primaryInstance (ModuleName "mod2"),+ Map.singleton (VarName "project.name") (mkResolved FromPrompt "app2" decl)+ )+ ]+ result = collectPromptedValues resolved Map.empty+ length result `shouldBe` 1++ it "handles multiple prompted variables" $ do+ let resolved =+ Map.singleton (primaryInstance (ModuleName "mod1")) $+ Map.fromList+ [ (VarName "license", mkResolved FromPrompt "MIT" (mkDecl "license")),+ (VarName "project.name", mkResolved FromPrompt "my-app" (mkDecl "project.name"))+ ]+ result = collectPromptedValues resolved Map.empty+ length result `shouldBe` 2++ it "returns empty list when no prompted values exist" $ do+ let resolved =+ Map.singleton (primaryInstance (ModuleName "mod1")) $+ Map.singleton (VarName "x") (mkResolved FromDefault "val" (mkDecl "x"))+ result = collectPromptedValues resolved Map.empty+ result `shouldBe` []++ describe "offerSavePrompted" $ do+ let entries =+ [ (VarName "project.name", "my-app", Nothing),+ (VarName "license", "MIT", Nothing)+ ]++ it "saves values when user confirms with 'y'" $ do+ (((), cwState), _consoleSt) <-+ runEff $+ runConsolePure ["y"] $+ runConfigWriterPure emptyConfigWriterState $+ offerSavePrompted Nothing True entries+ cwState.cwLocal `shouldBe` Map.fromList [("project.name", "my-app"), ("license", "MIT")]++ it "does not save when user declines with 'n'" $ do+ (((), cwState), _consoleSt) <-+ runEff $+ runConsolePure ["n"] $+ runConfigWriterPure emptyConfigWriterState $+ offerSavePrompted Nothing True entries+ cwState.cwLocal `shouldBe` Map.empty++ it "saves without asking when --save-prompted (Just True)" $ do+ (((), cwState), consoleSt) <-+ runEff $+ runConsolePure [] $+ runConfigWriterPure emptyConfigWriterState $+ offerSavePrompted (Just True) True entries+ cwState.cwLocal `shouldBe` Map.fromList [("project.name", "my-app"), ("license", "MIT")]+ -- Should not contain the confirmation prompt+ any (T.isInfixOf "Save prompted values") consoleSt.consoleOutputs `shouldBe` False++ it "skips entirely when --no-save-prompted (Just False)" $ do+ (((), cwState), consoleSt) <-+ runEff $+ runConsolePure [] $+ runConfigWriterPure emptyConfigWriterState $+ offerSavePrompted (Just False) True entries+ cwState.cwLocal `shouldBe` Map.empty+ consoleSt.consoleOutputs `shouldBe` []++ it "skips in non-interactive mode when no flag given" $ do+ (((), cwState), _consoleSt) <-+ runEff $+ runConsolePure [] $+ runConfigWriterPure emptyConfigWriterState $+ offerSavePrompted Nothing False entries+ cwState.cwLocal `shouldBe` Map.empty++ it "shows overwrite note for existing values" $ do+ let entriesWithOverwrite =+ [ (VarName "project.name", "new-app", Just "old-app")+ ]+ ((_result, _cwState), consoleSt) <-+ runEff $+ runConsolePure ["y"] $+ runConfigWriterPure emptyConfigWriterState $+ offerSavePrompted Nothing True entriesWithOverwrite+ any (T.isInfixOf "overwrites current") consoleSt.consoleOutputs `shouldBe` True++ it "does nothing when entries list is empty" $ do+ (((), cwState), consoleSt) <-+ runEff $+ runConsolePure [] $+ runConfigWriterPure emptyConfigWriterState $+ offerSavePrompted Nothing True []+ cwState.cwLocal `shouldBe` Map.empty+ consoleSt.consoleOutputs `shouldBe` []++ it "displays confirmation message after saving" $ do+ (((), _cwState), consoleSt) <-+ runEff $+ runConsolePure ["y"] $+ runConfigWriterPure emptyConfigWriterState $+ offerSavePrompted Nothing True entries+ any (T.isInfixOf "Saved 2 value(s)") consoleSt.consoleOutputs `shouldBe` True
+ test/Seihou/CLI/StatusSpec.hs view
@@ -0,0 +1,255 @@+module Seihou.CLI.StatusSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Seihou.CLI.StatusRender (formatStatus)+import Seihou.CLI.VersionCompare+ ( OutdatedEntry (..),+ OutdatedStatus (..),+ )+import Seihou.Core.Migration+ ( Migration (..),+ MigrationOp (..),+ MigrationPlan (..),+ )+import Seihou.Core.Types+ ( AppliedBlueprint (..),+ AppliedModule (..),+ Manifest (..),+ ModuleName (..),+ emptyParentVars,+ )+import Seihou.Core.Version qualified+import Seihou.Manifest.Types (emptyManifest)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.StatusRender" spec++fixedTime :: UTCTime+fixedTime =+ parseTimeOrError+ True+ defaultTimeLocale+ "%Y-%m-%dT%H:%M:%SZ"+ "2026-04-15T10:00:00Z"++mkApplied :: Text -> Maybe Text -> AppliedModule+mkApplied name mver =+ AppliedModule+ { name = ModuleName name,+ parentVars = emptyParentVars,+ source = "/installed/" <> T.unpack name,+ moduleVersion = mver,+ appliedAt = fixedTime,+ removal = Nothing+ }++mkManifest :: [AppliedModule] -> Manifest+mkManifest mods =+ (emptyManifest fixedTime)+ { modules = mods,+ files = Map.empty+ }++-- | Build a 'MigrationPlan' fixture for use with formatStatus.+mkPlan :: Text -> Text -> Text -> Int -> MigrationPlan+mkPlan modName from to nSteps =+ MigrationPlan+ { planModule = modName,+ planFrom = parseV from,+ planTo = parseV to,+ planSteps = replicate nSteps (Migration from to [DeleteFile "x"])+ }++parseV :: Text -> Seihou.Core.Version.Version+parseV t = case Seihou.Core.Version.parseVersion t of+ Just v -> v+ Nothing -> error ("test fixture: unparseable version " <> T.unpack t)++mkEntry :: Text -> Maybe Text -> Maybe Text -> OutdatedStatus -> OutdatedEntry+mkEntry name inst avail status =+ OutdatedEntry+ { moduleName = name,+ installedVersion = inst,+ availableVersion = avail,+ status = status+ }++mkBlueprint ::+ Text ->+ Maybe Text ->+ [Text] ->+ Bool ->+ Maybe Text ->+ AppliedBlueprint+mkBlueprint name mver baselines noBL prompt =+ AppliedBlueprint+ { name = ModuleName name,+ blueprintVersion = mver,+ appliedAt = fixedTime,+ baselineModules = map ModuleName baselines,+ noBaseline = noBL,+ userPrompt = prompt,+ agentSessionId = Nothing+ }++withManifestBlueprint :: Maybe AppliedBlueprint -> Manifest -> Manifest+withManifestBlueprint mb m = m {blueprint = mb}++spec :: Spec+spec = describe "formatStatus" $ do+ describe "blueprint provenance" $ do+ it "renders a populated blueprint with version, two baselines, and prompt" $ do+ let manifest =+ withManifestBlueprint+ ( Just $+ mkBlueprint+ "payments-service"+ (Just "0.3.1")+ ["nix-flake", "haskell-base"]+ False+ (Just "set this up for a payments microservice")+ )+ (mkManifest [])+ out = formatStatus False manifest [] Nothing []+ out `shouldSatisfy` T.isInfixOf "Blueprint: payments-service v0.3.1 (applied"+ out `shouldSatisfy` T.isInfixOf " Baseline: nix-flake, haskell-base"+ out `shouldSatisfy` T.isInfixOf " Prompt: \"set this up for a payments microservice\""++ it "renders --no-baseline as the dedicated placeholder" $ do+ let manifest =+ withManifestBlueprint+ ( Just $+ mkBlueprint "lone-blueprint" Nothing [] True Nothing+ )+ (mkManifest [])+ out = formatStatus False manifest [] Nothing []+ out `shouldSatisfy` T.isInfixOf "Blueprint: lone-blueprint (applied"+ out `shouldSatisfy` T.isInfixOf " Baseline: (none -- --no-baseline)"+ out `shouldNotSatisfy` T.isInfixOf " Prompt:"++ it "omits the Prompt line when no positional prompt was supplied" $ do+ let manifest =+ withManifestBlueprint+ ( Just $+ mkBlueprint+ "payments-service"+ (Just "0.3.1")+ ["nix-flake"]+ False+ Nothing+ )+ (mkManifest [])+ out = formatStatus False manifest [] Nothing []+ out `shouldSatisfy` T.isInfixOf "Blueprint: payments-service v0.3.1 (applied"+ out `shouldSatisfy` T.isInfixOf " Baseline: nix-flake"+ out `shouldNotSatisfy` T.isInfixOf " Prompt:"++ it "omits the entire blueprint section when manifest.blueprint is Nothing" $ do+ let manifest = withManifestBlueprint Nothing (mkManifest [])+ out = formatStatus False manifest [] Nothing []+ out `shouldNotSatisfy` T.isInfixOf "Blueprint: "+ out `shouldNotSatisfy` T.isInfixOf " Baseline:"++ it "renders an empty-baseline (no --no-baseline) blueprint with the (none declared) placeholder" $ do+ let manifest =+ withManifestBlueprint+ (Just $ mkBlueprint "pure-prompt" Nothing [] False Nothing)+ (mkManifest [])+ out = formatStatus False manifest [] Nothing []+ out `shouldSatisfy` T.isInfixOf "Blueprint: pure-prompt (applied"+ out `shouldSatisfy` T.isInfixOf " Baseline: (none declared)"++ it "all modules clean: no remediation, no Recommended actions block" $ do+ let am = mkApplied "demo" (Just "1.0.0")+ manifest = mkManifest [am]+ entries = Just [mkEntry "demo" (Just "1.0.0") (Just "1.0.0") UpToDate]+ out = formatStatus False manifest [] entries []+ out `shouldSatisfy` T.isInfixOf "demo"+ out `shouldSatisfy` T.isInfixOf "up to date"+ out `shouldNotSatisfy` T.isInfixOf "Run: seihou"+ out `shouldNotSatisfy` T.isInfixOf "Recommended actions"+ out `shouldNotSatisfy` T.isInfixOf "Pending migration"++ it "outdated only (no migration declared): per-row upgrade hint and summary entry" $ do+ let am = mkApplied "demo" (Just "0.1.0")+ manifest = mkManifest [am]+ entries = Just [mkEntry "demo" (Just "0.1.0") (Just "0.3.0") OutdatedSt]+ out = formatStatus False manifest [] entries []+ out `shouldSatisfy` T.isInfixOf "outdated: 0.3.0 available"+ out `shouldSatisfy` T.isInfixOf "Run: seihou upgrade demo"+ out `shouldSatisfy` T.isInfixOf "Recommended actions:"+ out `shouldSatisfy` T.isInfixOf " seihou upgrade demo"+ out `shouldNotSatisfy` T.isInfixOf "Pending migration"++ it "pending migration (full chain): per-row migrate hint and summary" $ do+ let am = mkApplied "demo" (Just "1.0.0")+ manifest = mkManifest [am]+ plan = mkPlan "demo" "1.0.0" "2.0.0" 1+ out = formatStatus False manifest [] Nothing [(ModuleName "demo", plan)]+ out `shouldSatisfy` T.isInfixOf "Pending migration: 1.0.0 -> 2.0.0 (1 step(s))"+ out `shouldSatisfy` T.isInfixOf "Run: seihou migrate demo"+ out `shouldSatisfy` T.isInfixOf "Recommended actions:"+ out `shouldSatisfy` T.isInfixOf " seihou migrate demo"+ out `shouldNotSatisfy` T.isInfixOf "seihou upgrade"++ it "outdated + pending migration: single migrate hint, no upgrade hint" $ do+ let am = mkApplied "demo" (Just "0.1.0")+ manifest = mkManifest [am]+ plan = mkPlan "demo" "0.1.0" "0.3.0" 6+ entries = Just [mkEntry "demo" (Just "0.1.0") (Just "0.3.0") OutdatedSt]+ out = formatStatus False manifest [] entries [(ModuleName "demo", plan)]+ out `shouldSatisfy` T.isInfixOf "outdated: 0.3.0 available"+ out `shouldSatisfy` T.isInfixOf "Pending migration: 0.1.0 -> 0.3.0 (6 step(s))"+ out `shouldSatisfy` T.isInfixOf "Run: seihou migrate demo"+ out `shouldNotSatisfy` T.isInfixOf "seihou upgrade demo"+ out `shouldSatisfy` T.isInfixOf "Recommended actions:"+ out `shouldSatisfy` T.isInfixOf " seihou migrate demo"++ -- Master-plan live-tree fixture: manifest=0.1.0, installed=0.3.0,+ -- declared [0.1.0 → 0.2.0]. The chain reaches 0.2 via ops; the+ -- supplied target is 0.3, so planTo = 0.3. Status surfaces the+ -- single in-window step and points at `seihou migrate demo` as the+ -- remediation.+ it "partial-cover plan: chain reaches an intermediate version, target is the user's installed copy" $ do+ let am = mkApplied "demo" (Just "0.1.0")+ manifest = mkManifest [am]+ plan = mkPlan "demo" "0.1.0" "0.3.0" 1+ out = formatStatus False manifest [] Nothing [(ModuleName "demo", plan)]+ out `shouldSatisfy` T.isInfixOf "Pending migration: 0.1.0 -> 0.3.0 (1 step(s))"+ out `shouldSatisfy` T.isInfixOf "Run: seihou migrate demo"+ out `shouldSatisfy` T.isInfixOf "Recommended actions:"+ out `shouldSatisfy` T.isInfixOf " seihou migrate demo"+ -- Doomed vocabulary is gone from status output.+ out `shouldNotSatisfy` T.isInfixOf "Blocked"+ out `shouldNotSatisfy` T.isInfixOf "no migration declared from"+ out `shouldNotSatisfy` T.isInfixOf "bump through"++ -- A module that has a version gap but no in-window declared+ -- migration still surfaces a pending advisory; the row reports+ -- 0 step(s) so the user knows `seihou migrate` will only advance+ -- the manifest.+ it "renders empty-steps plan with a 0-step pending row" $ do+ let am = mkApplied "demo" (Just "0.2.0")+ manifest = mkManifest [am]+ plan =+ MigrationPlan+ { planModule = "demo",+ planFrom = parseV "0.2.0",+ planTo = parseV "0.3.0",+ planSteps = []+ }+ out = formatStatus False manifest [] Nothing [(ModuleName "demo", plan)]+ out `shouldSatisfy` T.isInfixOf "Pending migration: 0.2.0 -> 0.3.0 (0 step(s))"+ out `shouldSatisfy` T.isInfixOf "Run: seihou migrate demo"+ out `shouldSatisfy` T.isInfixOf "Recommended actions:"+ out `shouldSatisfy` T.isInfixOf " seihou migrate demo"+ -- The doomed vocabulary stays out of the rendered status.+ out `shouldNotSatisfy` T.isInfixOf "Blocked"+ out `shouldNotSatisfy` T.isInfixOf "--bump-only"+ out `shouldNotSatisfy` T.isInfixOf "[blocked]"
+ test/Seihou/CLI/UpgradeSpec.hs view
@@ -0,0 +1,36 @@+module Seihou.CLI.UpgradeSpec (tests) where++import Seihou.CLI.VersionCompare (OutdatedStatus (..), compareVersions)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.Upgrade" spec++spec :: Spec+spec = do+ describe "compareVersions" $ do+ it "returns Unversioned when both versions are Nothing" $+ compareVersions Nothing Nothing `shouldBe` Unversioned++ it "returns Unversioned when installed version is Nothing" $+ compareVersions Nothing (Just "1.0") `shouldBe` Unversioned++ it "returns Unversioned when available version is Nothing" $+ compareVersions (Just "1.0") Nothing `shouldBe` Unversioned++ it "returns OutdatedSt when available version is newer" $+ compareVersions (Just "1.0") (Just "2.0") `shouldBe` OutdatedSt++ it "returns UpToDate when installed version is newer" $+ compareVersions (Just "2.0") (Just "1.0") `shouldBe` UpToDate++ it "returns UpToDate when versions are equal" $+ compareVersions (Just "1.0") (Just "1.0") `shouldBe` UpToDate++ it "returns Unversioned when version strings are unparseable" $+ compareVersions (Just "abc") (Just "def") `shouldBe` Unversioned++ it "returns Unversioned when one version is unparseable" $+ compareVersions (Just "1.0") (Just "abc") `shouldBe` Unversioned
+ test/Seihou/FzfSpec.hs view
@@ -0,0 +1,182 @@+module Seihou.FzfSpec (tests) where++import Data.Text qualified as T+import Seihou.Core.Module (DiscoveredModule (..), DiscoveredRunnable (..), ModuleSource (..), RunnableKind (..))+import Seihou.Core.Types+import Seihou.Effect.Fzf (selectOne)+import Seihou.Effect.FzfInterp (runFzfPure)+import Seihou.Fzf+ ( Candidate (..),+ FzfOpts,+ FzfResult (..),+ optsToArgs,+ withAnsi,+ withHeader,+ withHeight,+ withNoSort,+ withPreview,+ withPrompt,+ )+import Seihou.Fzf.Selector.Module (formatModuleCandidate, formatRunnableCandidate)+import Seihou.Prelude+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Fzf" spec++spec :: Spec+spec = do+ describe "optsToArgs" $ do+ it "produces empty args for mempty" $ do+ optsToArgs mempty `shouldBe` []++ it "produces --prompt flag" $ do+ optsToArgs (withPrompt "test> ") `shouldBe` ["--prompt", "test> "]++ it "produces --header flag" $ do+ optsToArgs (withHeader "Pick one") `shouldBe` ["--header", "Pick one"]++ it "produces --height flag" $ do+ optsToArgs (withHeight "40%") `shouldBe` ["--height", "40%"]++ it "produces --ansi flag" $ do+ optsToArgs withAnsi `shouldBe` ["--ansi"]++ it "produces --no-sort flag" $ do+ optsToArgs withNoSort `shouldBe` ["--no-sort"]++ it "produces --preview flag" $ do+ optsToArgs (withPreview "cat {}") `shouldBe` ["--preview", "cat {}"]++ it "combines options with <>" $ do+ let opts = withPrompt "p> " <> withHeight "50%" <> withAnsi+ optsToArgs opts `shouldBe` ["--prompt", "p> ", "--height", "50%", "--ansi"]++ describe "FzfOpts Monoid" $ do+ it "mempty is left identity" $ do+ let opts = withPrompt "test> "+ optsToArgs (mempty <> opts) `shouldBe` optsToArgs opts++ it "mempty is right identity" $ do+ let opts = withPrompt "test> "+ optsToArgs (opts <> mempty) `shouldBe` optsToArgs opts++ it "right-biases Maybe fields" $ do+ let a = withPrompt "first> "+ b = withPrompt "second> "+ optsToArgs (a <> b) `shouldBe` ["--prompt", "second> "]++ it "sticky-true for Bool fields" $ do+ let opts = withAnsi <> mempty+ optsToArgs opts `shouldBe` ["--ansi"]++ describe "runFzfPure" $ do+ it "selects candidate at given index" $ do+ let candidates =+ [ Candidate "alpha" ("a" :: Text),+ Candidate "beta" "b",+ Candidate "gamma" "c"+ ]+ result <- runEff $ runFzfPure 1 $ selectOne mempty candidates+ case result of+ FzfSelected val -> val `shouldBe` "b"+ _ -> expectationFailure "expected FzfSelected"++ it "returns FzfNoMatch for negative index" $ do+ let candidates = [Candidate "alpha" ("a" :: Text)]+ result <- runEff $ runFzfPure (-1) $ selectOne mempty candidates+ case result of+ FzfNoMatch -> pure ()+ _ -> expectationFailure "expected FzfNoMatch"++ it "returns FzfNoMatch for out-of-bounds index" $ do+ let candidates = [Candidate "alpha" ("a" :: Text)]+ result <- runEff $ runFzfPure 5 $ selectOne mempty candidates+ case result of+ FzfNoMatch -> pure ()+ _ -> expectationFailure "expected FzfNoMatch"++ it "returns FzfNoMatch for empty candidates" $ do+ result <- runEff $ runFzfPure 0 $ selectOne mempty ([] :: [Candidate Text])+ case result of+ FzfNoMatch -> pure ()+ _ -> expectationFailure "expected FzfNoMatch"++ describe "formatModuleCandidate" $ do+ it "returns Just for a valid module" $ do+ let dm = validModule "test-mod" "A test module" SourceUser+ case formatModuleCandidate dm of+ Just c -> do+ c.candidateValue `shouldBe` ModuleName "test-mod"+ T.isInfixOf "test-mod" c.candidateDisplay `shouldBe` True+ T.isInfixOf "[user]" c.candidateDisplay `shouldBe` True+ Nothing -> expectationFailure "expected Just"++ it "returns Nothing for a failed module" $ do+ let dm =+ DiscoveredModule+ { discoveredResult = Left (ModuleNotFound (ModuleName "bad") []),+ discoveredSource = SourceProject,+ discoveredDir = "/tmp/bad"+ }+ case formatModuleCandidate dm of+ Nothing -> pure ()+ Just _ -> expectationFailure "expected Nothing"++ it "includes description when present" $ do+ let dm = validModule "mod" "My description" SourceInstalled+ case formatModuleCandidate dm of+ Just c -> T.isInfixOf "My description" c.candidateDisplay `shouldBe` True+ Nothing -> expectationFailure "expected Just"++ it "tags source correctly" $ do+ let dmProject = validModule "m" "d" SourceProject+ dmUser = validModule "m" "d" SourceUser+ dmInstalled = validModule "m" "d" SourceInstalled+ case (formatModuleCandidate dmProject, formatModuleCandidate dmUser, formatModuleCandidate dmInstalled) of+ (Just p, Just u, Just i) -> do+ T.isInfixOf "[project]" p.candidateDisplay `shouldBe` True+ T.isInfixOf "[user]" u.candidateDisplay `shouldBe` True+ T.isInfixOf "[installed]" i.candidateDisplay `shouldBe` True+ _ -> expectationFailure "expected all Just"++ describe "formatRunnableCandidate" $ do+ it "tags prompt candidates with [prompt]" $ do+ let dr =+ DiscoveredRunnable+ { drName = "review-changes",+ drDescription = Just "Review current changes",+ drKind = KindPrompt,+ drSource = SourceProject,+ drDir = "/tmp/review-changes",+ drIsError = False,+ drError = Nothing+ }+ case formatRunnableCandidate dr of+ Just c -> T.isInfixOf "[prompt]" c.candidateDisplay `shouldBe` True+ Nothing -> expectationFailure "expected Just"++-- | Helper to create a valid discovered module for testing.+validModule :: String -> String -> ModuleSource -> DiscoveredModule+validModule name desc src =+ DiscoveredModule+ { discoveredResult =+ Right+ Module+ { name = ModuleName (T.pack name),+ version = Nothing,+ description = Just (T.pack desc),+ vars = [],+ exports = [],+ prompts = [],+ steps = [],+ commands = [],+ dependencies = [],+ removal = Nothing,+ migrations = []+ },+ discoveredSource = src,+ discoveredDir = "/tmp/" ++ name+ }