packages feed

seihou-cli 0.11.0.1 → 0.12.0.0

raw patch · 42 files changed

+1504/−412 lines, 42 filesdep ~seihou-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: seihou-core

API changes (from Hackage documentation)

+ Seihou.CLI.AgentCompletion: migrationAllowedTools :: [String] -> [String]
+ Seihou.CLI.AgentCompletion: resolveAgentInitialPrompt :: AgentProvider -> Maybe Text -> Maybe Text
+ Seihou.CLI.AgentCompletion: runAgentMigrationCompletionWithCliAccess :: [FilePath] -> [String] -> AgentCompletionRequest -> IO (Either Text Text)
+ Seihou.CLI.AgentMigrationProtocol: validateMigrationOutput :: Bool -> ByteString -> Either Text Text
+ Seihou.CLI.InstallClosure: installClosure :: Bool -> FilePath -> Text -> [(Text, FilePath)] -> IO (Either Text ())
+ Seihou.CLI.InstallClosure: installClosureInto :: FilePath -> Bool -> FilePath -> Text -> [(Text, FilePath)] -> IO (Either Text ())
+ Seihou.CLI.InstallClosure: instance GHC.Internal.Generics.Generic Seihou.CLI.InstallClosure.Entry
+ Seihou.CLI.SavePrompted: collectRecipePromptedValues :: Map VarName ResolvedVar -> Map ModuleInstance (Map VarName ResolvedVar) -> Map VarName Text -> [(VarName, Text, Maybe Text)]
+ Seihou.CLI.ValidateRecipeReport: recipeLoadErrorText :: ModuleLoadError -> Text

Files

data/assist-prompt.md view
@@ -94,6 +94,7 @@ - `seihou new-module NAME` — scaffold a new module with boilerplate - `seihou new-blueprint NAME [--path DIR]` — scaffold a new blueprint (agent-driven) - `seihou new-prompt NAME [--path DIR]` — scaffold a reusable agent-session prompt+- `seihou validate-recipe [PATH]` — validate recipe.dhall without composition - `seihou validate-module [PATH]` — validate module.dhall - `seihou validate-blueprint [PATH]` — validate blueprint.dhall - `seihou validate-prompt [PATH]` — validate prompt.dhall@@ -139,3 +140,11 @@ - 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.++For recipe authoring, run `seihou validate-recipe ./RECIPE` (omit PATH for the+current directory). CI uses `seihou validate-recipe ./RECIPE </dev/null`. This+validates descriptor fields, declarations, prompts, conditions and binding names+without answers, installed members, generation or commands. Required variables+without defaults are valid. Dhall imports evaluate normally; remote imports may+need network/cache access. Use registry validate for entry metadata and run+--dry-run to resolve inputs/members and preview composition.
data/bootstrap-prompt.md view
@@ -233,6 +233,7 @@ - `seihou new-module NAME` — scaffold a new module with boilerplate - `seihou new-blueprint NAME [--path DIR]` — scaffold a new blueprint (agent-driven) - `seihou new-prompt NAME [--path DIR]` — scaffold a reusable agent-session prompt+- `seihou validate-recipe [PATH]` — validate recipe.dhall without answers or installed members - `seihou validate-module [PATH]` — validate module.dhall - `seihou validate-blueprint [PATH]` — validate blueprint.dhall - `seihou validate-prompt [PATH]` — validate prompt.dhall@@ -308,7 +309,7 @@    `seihou agent migrate NAME`. Inspect with parent `--debug` before launching.    See `seihou help blueprints` and `seihou help migrations`. -8. **Validate**: Run `seihou validate-module ./MODULE`,+8. **Validate**: Run `seihou validate-recipe ./RECIPE`, `seihou validate-module ./MODULE`,    `seihou validate-blueprint ./BLUEPRINT`, or    `seihou validate-prompt ./PROMPT` and fix any issues. @@ -325,6 +326,12 @@ ## 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 validation commands such as `seihou validate-recipe ./RECIPE`, `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.++Recipe descriptor checks need no values or installed members. For CI run+`seihou validate-recipe ./RECIPE </dev/null`. Dhall imports evaluate normally and+remote imports may need network access. This checks declarations, prompt/condition+references and bindings, not member behavior. Use registry validate for metadata+and run --dry-run for a composition preview once members and inputs are available.
data/module-reference.md view
@@ -122,6 +122,28 @@ without new generation logic, use `seihou new-recipe NAME --module MODULE` (repeat `--module`), then `seihou run NAME`; see `seihou help recipes`. +### Recipe declarations and acquisition++Recipe members, module dependencies and blueprint base modules can declare+`S.Dependency::{ module = "external", source = Some "https://host/registry.git" }`.+An omitted source means the declaring registry during install. Sources are literal+Git URLs, not variable expressions. `seihou install SOURCE --module RECIPE` acquires+the required closure; run and dry-run use local members and do not fetch. Upgrade+the runtime to Seihou 0.12.0.0 before publishing source declarations.++Recipes may declare shared typed variables and ordered conditional prompts.+Recipe precedence is CLI, literal member bindings, saved recipe inputs on update,+environment, local/namespace/context/global config, then recipe defaults. A required+choice with no default asks once before member defaults and must be supplied in+CI. Explicit false remains a value. Prompt conditions control interaction; they do+not waive a required declaration. Use optional declarations for conditional details.+Accepted recipe inputs are recorded in manifest schema 12 and replayed by ordinary+update. Each consumer still validates the supplied value.++Use `seihou validate-recipe PATH` for descriptor-only checks without answers or+installed members. CI can run `seihou validate-recipe ./my-stack </dev/null`.+Descriptor-authored Dhall imports evaluate normally and may use the network.+ ### Removal  ```dhall
data/setup-prompt.md view
@@ -37,7 +37,9 @@  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`).+   repositories if needed (`seihou browse`). Installing a selected recipe acquires+   its required module closure, including declared external registry sources; no+   transitive module list is needed. Reinstall repairs incomplete old installations.  3. **Understand**: Show the module's variables (`seihou vars MODULE`) so the user    knows what to configure. Use `--explain` to show resolution sources.@@ -144,6 +146,14 @@ - `seihou upgrade [MODULE] [--dry-run]` — deliberate installed-cache maintenance - `seihou migrate MODULE [--dry-run] [--to VERSION]` — lower-level migration control - See `seihou help update`, `seihou help sync`, and `seihou help manifest`.++### Recipe choices++Recipes resolve their own declarations and conditional prompts before member+defaults. A required choice without a default needs an answer or explicit --var+in automation; a member default cannot answer it. Accepted choices are recorded+in manifest schema 12 and replayed by ordinary update in fresh clones. Use+--reconfigure deliberately to change them. See `seihou help recipes`.  ### Status and diagnostics - `seihou status [--full-prompt]` — inspect recorded applications, artifact identity/version warnings, pending migrations and checkout links; pending updates name the recorded root target
help/agent.md view
@@ -214,3 +214,20 @@   seihou help prompts   docs/cli/agent.md   docs/user/config-and-variables.md+++Blueprint migration CLI sessions automatically run in batch mode when stdin is+not a terminal. Use `seihou agent migrate BLUEPRINT --batch` to request batch+mode explicitly, including when only stdout is redirected. Authenticate the+selected `claude` or `codex` CLI first and supply required blueprint inputs with+`--var KEY=VALUE` or normal configuration. Batch mode keeps workspace permissions,+blueprint tools, and reference directories; it does not bypass approvals.+It also preapproves specific read-only Mori discovery commands for dependency+inspection, excluding registry mutations.++Batch processes return when work finishes. With terminal input, sessions remain+interactive: exit each session normally to record its edge. If a batch provider+fails, reports a permission denial, or returns incomplete output, no receipt is+written for that edge. Inspect partial edits, repair the reported problem, and+rerun the same command; completed edges are skipped. Receipts do not verify that+the migrated project builds or passes tests.
help/blueprints.md view
@@ -188,3 +188,20 @@   docs/cli/validate-blueprint.md   command reference for validation   seihou help variables            variable precedence and overrides   seihou help modules              deterministic module authoring+++Blueprint migration CLI sessions automatically run in batch mode when stdin is+not a terminal. Use `seihou agent migrate BLUEPRINT --batch` to request batch+mode explicitly, including when only stdout is redirected. Authenticate the+selected `claude` or `codex` CLI first and supply required blueprint inputs with+`--var KEY=VALUE` or normal configuration. Batch mode keeps workspace permissions,+blueprint tools, and reference directories; it does not bypass approvals.+It also preapproves specific read-only Mori discovery commands for dependency+inspection, excluding registry mutations.++Batch processes return when work finishes. With terminal input, sessions remain+interactive: exit each session normally to record its edge. If a batch provider+fails, reports a permission denial, or returns incomplete output, no receipt is+written for that edge. Inspect partial edits, repair the reported problem, and+rerun the same command; completed edges are skipped. Receipts do not verify that+the migrated project builds or passes tests.
help/manifest.md view
@@ -63,8 +63,9 @@       8 -> 9  checkout outputs       9 -> 10 repeatable checkout commands       10 -> 11 precise seed ownership claims+      11 -> 12 recipe inputs -    ✓ Upgraded .seihou/manifest.json to schema version 11.+    ✓ Upgraded .seihou/manifest.json to schema version 12.       Review the diff and commit it: git diff .seihou/manifest.json    Running it on a manifest that is already current reports that there is@@ -126,7 +127,7 @@   The write is atomic: a complete temporary file is renamed over the manifest,   so an interrupted run cannot leave a truncated one. -SCHEMA 8 THROUGH 11+SCHEMA 8 THROUGH 12    Schema 8 adds content-free seed receipts; schema 11 records exact application/   qualified-instance claims and explicitly preserves legacy ownership uncertainty.@@ -137,6 +138,15 @@   A maintainer adopts changed declarations through ordinary update and commits   them. Teammates receive that commit and run seihou sync, without producers.   Sync does not fetch, upgrade or write the manifest. See seihou help sync.++RECIPE INPUTS++  Schema 12 records accepted recipe inputs on each application, including values+  used only by prompt conditions. The lossless 11-to-12 upgrade records unknown+  inputs rather than guessing values. Ordinary recipe update reuses recorded+  choices or adopts agreeing historical consumer values through its preview.+  Conflicts need an explicit --var KEY=VALUE or --reconfigure. No JSON edits or+  separate upgrade command are required for an ordinary recipe update.  SEE ALSO 
help/recipes.md view
@@ -7,6 +7,7 @@ AUTHOR AND RUN    seihou new-recipe my-stack --module base --module editor+  seihou validate-recipe ./my-stack    This creates my-stack/recipe.dhall with the selected modules. Edit the   generated definition to add variables or bindings. Preserve its field shapes. Put it in a normal search path (for example@@ -17,9 +18,20 @@   seihou run my-stack    Dependencies resolve before generation. Supply declared values with --var-  or normal config scopes. There is no validate-recipe command; inspect vars-  and the run preview, and use registry validate for published entry metadata.+  or normal config scopes for composition. Validate the descriptor separately: +  seihou validate-recipe ./my-stack </dev/null++  PATH defaults to the current directory. Validation checks Dhall, declarations,+  prompts, condition references and binding names without asking for values,+  finding/installing members, generating files or executing commands. Required+  variables without defaults are valid. Exit codes: valid 0, invalid/unreadable 1,+  missing recipe.dhall 4. Correct the named field and rerun. Dhall imports are+  evaluated normally and remote imports may need network/cache access.++  registry validate checks entry metadata; validate-recipe checks the descriptor;+  run --dry-run resolves values and members to preview composition.+ UPDATES    seihou update my-stack@@ -46,3 +58,49 @@   seihou help update   seihou help registry   seihou new-recipe --help+  seihou validate-recipe --help++## Installing required modules++`seihou install SOURCE --module RECIPE` installs the selected recipe and its complete+module dependency closure, including external registries declared with+`source = Some "GIT-URL"`. Then use `seihou run RECIPE` with ordinary recipe inputs.+A missing source means the declaring registry during install. Reinstalling repairs+older incomplete installs. Run and dry-run use local modules and never fetch.++Preflight failures leave installed artifacts unchanged. Correct a missing source or+entry and retry the same command. Existing foreign cache entries require an informed+`--force`; contradictory sources within one closure always fail. A local shadow must+have verifiable matching provenance for an explicit source requirement.++## Recipe inputs++Recipe inputs are resolved before module variables. A required recipe boolean+without a default asks once on an interactive terminal, even when every consuming+module defaults it to false. In automation, supply `--var git.createGithub=false`+(or configuration); missing required choices fail before generation.++Recipe precedence is CLI, literal recipe bindings, saved recipe inputs on update,+environment, local/namespace/context/global configuration, then recipe defaults.+Resolved recipe inputs override module saved values and defaults. Each consumer+still validates the value. Explicit false is a value, not an omitted answer.+Optional prompt conditions see typed recipe values and earlier answers; a false+condition skips interaction but does not waive a required declaration.++Successful runs record recipe inputs in the checked-in manifest, including inputs+used only by conditions. `seihou update RECIPE` reuses them in fresh clones;+`--reconfigure` discards saved choices. Older applications adopt agreeing consumer+values during ordinary preview; conflicts require `--var KEY=VALUE` or+`--reconfigure`. Saving prompted values to local config remains optional and+respects `--save-prompted` and `--no-save-prompted`; previews do not save them.++For example, a recipe can own a shared boolean decision:++```dhall+vars = [ S.VarDecl::{ name = "git.createGithub", type = "bool", required = True } ]+prompts = [ S.Prompt::{ var = "git.createGithub", text = "Create a GitHub repository?" } ]+```++`seihou run RECIPE` asks once; `seihou run RECIPE --var git.createGithub=false`+supplies an explicit answer without a terminal. Modules declaring that name receive+the answer above their own defaults.
help/registry.md view
@@ -18,7 +18,7 @@   without writing; use it in CI. Validate checks structure and version agreement.   Both commands accept --dir PATH, work locally and do not read installed copies. -  Validate item contents with validate-module, validate-blueprint or+  Validate item contents with validate-module, validate-recipe, validate-blueprint or   validate-prompt as appropriate; registry validation checks metadata.  CONSUMERS@@ -37,3 +37,16 @@   seihou help recipes   seihou help blueprints   seihou help prompts++## Installing required modules++`seihou install SOURCE --module RECIPE` installs the selected recipe and its complete+module dependency closure, including external registries declared with+`source = Some "GIT-URL"`. Then use `seihou run RECIPE` with ordinary recipe inputs.+A missing source means the declaring registry during install. Reinstalling repairs+older incomplete installs. Run and dry-run use local modules and never fetch.++Preflight failures leave installed artifacts unchanged. Correct a missing source or+entry and retry the same command. Existing foreign cache entries require an informed+`--force`; contradictory sources within one closure always fail. A local shadow must+have verifiable matching provenance for an explicit source requirement.
help/update.md view
@@ -91,6 +91,12 @@   `--reconfigure` intentionally ignores saved values and resolves every input   again. Use it to change configuration, not for routine source updates. +  Recipe applications also reuse recorded recipe inputs before member variables.+  Inputs used only by conditions survive fresh clones. Ordinary preview prepares+  schema 12 as needed and adopts agreeing historical values; conflicting or newly+  required choices need --var KEY=VALUE or --reconfigure. Recipe-only changes are+  recorded even when no generated file changes.+ MIGRATIONS    Applicable module migrations are always included. Declarative moves and
help/variables.md view
@@ -51,3 +51,24 @@   The namespace selects a separate config file, not a prefix added to every   variable name. Use --namespace NS to override the artifact's default   namespace. `seihou vars NAME --explain` reports the resolved source.++## Recipe inputs++Recipe inputs are resolved before module variables. A required recipe boolean+without a default asks once on an interactive terminal, even when every consuming+module defaults it to false. In automation, supply `--var git.createGithub=false`+(or configuration); missing required choices fail before generation.++Recipe precedence is CLI, literal recipe bindings, saved recipe inputs on update,+environment, local/namespace/context/global configuration, then recipe defaults.+Resolved recipe inputs override module saved values and defaults. Each consumer+still validates the value. Explicit false is a value, not an omitted answer.+Optional prompt conditions see typed recipe values and earlier answers; a false+condition skips interaction but does not waive a required declaration.++Successful runs record recipe inputs in the checked-in manifest, including inputs+used only by conditions. `seihou update RECIPE` reuses them in fresh clones;+`--reconfigure` discards saved choices. Older applications adopt agreeing consumer+values during ordinary preview; conflicts require `--var KEY=VALUE` or+`--reconfigure`. Saving prompted values to local config remains optional and+respects `--save-prompted` and `--no-save-prompted`; previews do not save them.
seihou-cli.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-cli-version: 0.11.0.1+version: 0.12.0.0 synopsis: CLI for Seihou project scaffolding description:   Command-line interface for Seihou, a composable project scaffolding@@ -66,6 +66,7 @@     Seihou.CLI.AgentConfigShow     Seihou.CLI.AgentGuard     Seihou.CLI.AgentLaunch+    Seihou.CLI.AgentMigrationProtocol     Seihou.CLI.AgentModels     Seihou.CLI.AgentTrace     Seihou.CLI.ApplicationDisplay@@ -84,6 +85,7 @@     Seihou.CLI.Extension     Seihou.CLI.Git     Seihou.CLI.Init+    Seihou.CLI.InstallClosure     Seihou.CLI.InstallHistory     Seihou.CLI.InstallShared     Seihou.CLI.KitConfig@@ -116,6 +118,7 @@     Seihou.CLI.Update.Source     Seihou.CLI.Update.Types     Seihou.CLI.UpgradeDiagnosis+    Seihou.CLI.ValidateRecipeReport     Seihou.CLI.VersionCompare     Seihou.Effect.Fzf     Seihou.Effect.FzfInterp@@ -141,7 +144,7 @@     generic-lens >=2.2 && <3,     lens >=5.2 && <6,     process >=1.6 && <2,-    seihou-core ^>=0.11.0.1,+    seihou-core ^>=0.12.0.0,     streamly-core >=0.3 && <0.5,     temporary >=1.3 && <2,     text >=2.0 && <3,@@ -204,6 +207,7 @@     Seihou.CLI.Validate     Seihou.CLI.ValidateBlueprint     Seihou.CLI.ValidatePrompt+    Seihou.CLI.ValidateRecipe     Seihou.CLI.Vars     Seihou.CLI.Version @@ -228,7 +232,7 @@     optparse-applicative >=0.18 && <1,     process >=1.6 && <2,     seihou-cli-internal,-    seihou-core ^>=0.11.0.1,+    seihou-core ^>=0.12.0.0,     temporary >=1.3 && <2,     text >=2.0 && <3,     time >=1.12 && <2,@@ -269,6 +273,7 @@     Seihou.CLI.ExtensionSpec     Seihou.CLI.GitSpec     Seihou.CLI.InitSpec+    Seihou.CLI.InstallClosureSpec     Seihou.CLI.InstallCollisionSpec     Seihou.CLI.InstallHistorySpec     Seihou.CLI.InstallSourceSpec@@ -280,6 +285,7 @@     Seihou.CLI.MigrateSpec     Seihou.CLI.PendingMigrationSpec     Seihou.CLI.PromptRenderSpec+    Seihou.CLI.RecipeInputsE2ESpec     Seihou.CLI.RecordedReleaseSpec     Seihou.CLI.Registry.SyncSpec     Seihou.CLI.Registry.ValidateSpec@@ -301,6 +307,7 @@     Seihou.CLI.UpgradeDiagnosisSpec     Seihou.CLI.UpgradeFixture     Seihou.CLI.UpgradeSpec+    Seihou.CLI.ValidateRecipeE2ESpec     Seihou.FzfSpec    build-tool-depends:@@ -320,7 +327,7 @@     lens >=5.2 && <6,     process >=1.6 && <2,     seihou-cli-internal,-    seihou-core ^>=0.11.0.1,+    seihou-core ^>=0.12.0.0,     streamly-core >=0.3 && <0.5,     tasty >=1.4 && <2,     tasty-hspec >=1.2 && <2,
src-exe/Main.hs view
@@ -50,6 +50,7 @@ import Seihou.CLI.Validate (handleValidateModule) import Seihou.CLI.ValidateBlueprint (handleValidateBlueprint) import Seihou.CLI.ValidatePrompt (handleValidatePrompt)+import Seihou.CLI.ValidateRecipe (handleValidateRecipe) import Seihou.CLI.Vars (handleVars) import Seihou.CLI.Version (seihouVersionWithGit) import Seihou.Core.Module (RunnableKind (..))@@ -119,6 +120,8 @@       handleValidateModule validateOpts     ValidateBlueprint validateBpOpts ->       handleValidateBlueprint validateBpOpts+    ValidateRecipe validateRecipeOpts ->+      handleValidateRecipe validateRecipeOpts     ValidatePrompt validatePromptOpts ->       handleValidatePrompt validatePromptOpts     Config configOpts ->
src-exe/Seihou/CLI/AgentMigrate.hs view
@@ -21,7 +21,10 @@   ( AgentModelConfig (..),     AgentProvider (..),     buildAgentCompletionRequestWith,+    migrationAllowedTools,+    resolveAgentInitialPrompt,     runAgentCompletion,+    runAgentMigrationCompletionWithCliAccess,   ) import Seihou.CLI.AgentConfig   ( PendingAgentConfig,@@ -96,6 +99,7 @@   ) import System.Exit (ExitCode (..), exitFailure, exitWith) import System.FilePath (takeDirectory)+import System.IO (hFlush, hIsTerminalDevice, stdin, stdout) import System.Timeout (timeout)  migrationPromptTemplate :: Text@@ -103,6 +107,8 @@  handleAgentMigrate :: Bool -> PendingAgentConfig -> BlueprintMigrationOpts -> IO () handleAgentMigrate debug pendingConfig opts = do+  terminal <- hIsTerminalDevice stdin+  let batchMode = opts ^. #batch || not terminal   let level = if opts ^. #verbose then LogVerbose else LogNormal       manifestPath = ".seihou" </> "manifest.json" @@ -250,12 +256,18 @@                           position                           total                           step+                          <> if batchMode && modelConfig ^. #provider == AgentProviderClaudeCli+                            then+                              "\n\n## Batch execution permissions\n\nThis run has no approval terminal. Preapproved tools: "+                                <> T.intercalate ", " (map T.pack (migrationAllowedTools (prepared ^. #allowedTools)))+                                <> ". Use native Read, Glob, and Grep tools with absolute paths for dependency-source inspection; do not cd into dependency checkouts. Use native file tools for edits. Run shell commands individually: no cd wrappers, command substitution, pipelines, or chained commands. Do not invoke shell commands outside these grants or request additional permissions. A reported permission denial fails this attempt even if you later recover. If a validation command is outside the grants, complete the authorized edits and report that exact check as pending.\n"+                            else ""                   renderDebugStep position total step =                     renderStep position total step                       <> maybe                         ""                         ("\n\n===== Initial user instruction =====\n" <>)-                        (opts ^. #prompt)+                        (resolveAgentInitialPrompt (modelConfig ^. #provider) (opts ^. #prompt))                if debug                 then@@ -274,7 +286,7 @@                   createDirectoryIfMissing True (takeDirectory signalPath)                   result <-                     runBlueprintMigrationsWith-                      (launchMigration traceSink modelConfig opts preparedByOwner signalPath renderStep)+                      (launchMigration batchMode traceSink modelConfig opts preparedByOwner signalPath renderStep)                       (recordMigration manifestPath cohort)                       pending                   handleRunResult level (blueprint ^. #name) result@@ -619,6 +631,7 @@       pure (Just (fromMaybe unstatedNotApplicableReason firstLine))  launchMigration ::+  Bool ->   -- | built once per command, so every migration edge appends to one destination   TraceSink ->   AgentModelConfig ->@@ -632,22 +645,33 @@   Int ->   BlueprintMigrationStep ->   IO (Either BlueprintMigrationLaunchFailure BlueprintMigrationLaunchResult)-launchMigration traceSink modelConfig opts preparedByOwner signalPath renderStep position total step = do+launchMigration batchMode traceSink modelConfig opts preparedByOwner signalPath renderStep position total step = do   TIO.putStrLn $     "Running blueprint migration "       <> stepLabel       <> ": "       <> formatMigrationStepLabel step+      <> (if batchMode then " (batch)" else " (interactive)")+  hFlush stdout   clearNotApplicableSignal signalPath   let systemPrompt = renderStep position total step   case Map.lookup (step ^. #owner) preparedByOwner of     Nothing -> pure (Left (BlueprintMigrationProviderFailure (missingOwnerMessage step)))     Just prepared -> case modelConfig ^. #provider of-      AgentProviderClaudeCli -> launchInteractive prepared systemPrompt-      AgentProviderCodexCli -> launchInteractive prepared systemPrompt+      AgentProviderClaudeCli -> launchCli prepared systemPrompt+      AgentProviderCodexCli -> launchCli prepared systemPrompt       AgentProviderAnthropic -> launchCompletion systemPrompt       AgentProviderOpenAI -> launchCompletion systemPrompt   where+    launchCli prepared systemPrompt+      | batchMode =+          finishCompletion $+            runAgentMigrationCompletionWithCliAccess+              (maybeToList (prepared ^. #mountedFilesDir))+              (prepared ^. #allowedTools)+              (buildAgentCompletionRequestWith traceSink modelConfig systemPrompt (opts ^. #prompt))+      | otherwise = launchInteractive prepared systemPrompt+     stepLabel = T.pack (show position) <> "/" <> T.pack (show total)      -- An interactive session communicates only through its exit code, so the@@ -663,7 +687,7 @@           (prepared ^. #allowedTools)           False           systemPrompt-          (opts ^. #prompt)+          (resolveAgentInitialPrompt (modelConfig ^. #provider) (opts ^. #prompt))       case exitCode of         ExitSuccess -> Right <$> sessionResultFromSignal Nothing         failure -> do@@ -674,10 +698,13 @@     -- An API provider hands us its reply directly, so the marker line works.     -- The signal file is still checked, because a provider given tool access     -- may take the prompt's first instruction rather than its fallback.-    launchCompletion systemPrompt = do-      result <-+    launchCompletion systemPrompt =+      finishCompletion $         runAgentCompletion           (buildAgentCompletionRequestWith traceSink modelConfig systemPrompt (opts ^. #prompt))++    finishCompletion action = do+      result <- action       case result of         Left err -> do           clearNotApplicableSignal signalPath
src-exe/Seihou/CLI/AgentRun.hs view
@@ -70,7 +70,7 @@   ) import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName) import Seihou.Composition.Plan (ComposedPlan (..), compileComposedPlan)-import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts)+import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts, verifyDependencySources) import Seihou.Core.Application (attachApplication, buildAppliedComposition, mkApplicationId, replaceAppliedComposition) import Seihou.Core.ArtifactOriginDetect (detectArtifactOrigin) import Seihou.Core.Checkout@@ -140,6 +140,13 @@           <> opts ^. #name . #unModuleName           <> "'?"     Left err -> exitErr level (renderModuleLoadError err)++  unless (opts ^. #noBaseline) $ do+    paths <- defaultSearchPaths+    sourceCheck <- verifyDependencySources paths blueprintDir (bp ^. #baseModules)+    case sourceCheck of+      Left err -> exitErr level (T.pack (show err))+      Right () -> pure ()    -- (a2) Resolve the baseline composition — every declared base module plus   -- its transitive dependencies — before anything is written. 'seihou run'
src-exe/Seihou/CLI/Commands.hs view
@@ -12,6 +12,7 @@     ValidateOpts (..),     ValidateBlueprintOpts (..),     ValidatePromptOpts (..),+    ValidateRecipeOpts (..),     ConfigOpts (..),     ConfigAction (..),     ContextAction (..),@@ -83,6 +84,7 @@   | ValidateModule ValidateOpts   | ValidateBlueprint ValidateBlueprintOpts   | ValidatePrompt ValidatePromptOpts+  | ValidateRecipe ValidateRecipeOpts   | Config ConfigOpts   | Context ContextAction   | Browse BrowseOpts@@ -268,6 +270,11 @@   }   deriving stock (Eq, Show, Generic) +data ValidateRecipeOpts = ValidateRecipeOpts+  { path :: !(Maybe FilePath)+  }+  deriving stock (Eq, Show, Generic)+ data ConfigAction   = ConfigSet Text Text   | ConfigGet Text@@ -420,6 +427,7 @@     namespace :: !(Maybe Text),     context :: !(Maybe Text),     verbose :: !Bool,+    batch :: !Bool,     rerun :: !Bool,     -- | When 'True', record a receipt for every pending step in the window     -- without starting an agent session, on the user's assertion that the@@ -515,6 +523,7 @@           <> command "validate-module" validateInfo           <> command "validate-blueprint" validateBlueprintInfo           <> command "validate-prompt" validatePromptInfo+          <> command "validate-recipe" validateRecipeInfo           <> command "vars" varsInfo           <> command "schema-upgrade" schemaUpgradeInfo           <> command "registry" registryInfo@@ -1144,6 +1153,25 @@       <$> optional (argument str (metavar "PATH"))       <*> switch (long "lint" <> help "Include advisory lint warnings") +validateRecipeInfo :: ParserInfo Command+validateRecipeInfo =+  info+    (ValidateRecipe . ValidateRecipeOpts <$> optional (argument str (metavar "PATH")))+    ( fullDesc+        <> progDesc "Validate a recipe descriptor without running its composition"+        <> footerDoc+          ( Just $+              vsep+                [ pretty ("Checks recipe.dhall, declarations, prompts, conditions, and binding names." :: String),+                  pretty ("PATH is a directory and defaults to the current directory." :: String),+                  pretty ("Does not ask questions, resolve members, generate files, or install modules." :: String),+                  pretty ("Dhall imports are evaluated normally and may require network access." :: String),+                  line,+                  pretty ("CI: seihou validate-recipe ./my-stack </dev/null" :: String)+                ]+          )+    )+ validatePromptInfo :: ParserInfo Command validatePromptInfo =   info@@ -2031,7 +2059,11 @@         <> footerDoc           ( Just $               vsep-                [ pretty ("Selects the blueprint migrations inside the version window," :: String),+                [ pretty ("CLI migrations run in batch mode when stdin is not a terminal." :: String),+                  pretty ("Use --batch to request this explicitly. Terminal sessions stay interactive;" :: String),+                  pretty ("exit each session normally before its edge is recorded." :: String),+                  line,+                  pretty ("Selects the blueprint migrations inside the version window," :: String),                   pretty ("runs one provider interaction per edge, and records each successful" :: String),                   pretty ("edge so an interrupted chain resumes without repeating completed work." :: String),                   line,@@ -2088,6 +2120,7 @@       <*> 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 "batch" <> help "Run non-interactively (automatic when stdin is not a terminal)")       <*> switch (long "rerun" <> help "Run matching migrations even when a receipt already exists")       <*> switch         ( long "mark-applied"
src-exe/Seihou/CLI/Install.hs view
@@ -6,43 +6,37 @@   ) where -import Control.Applicative ((<|>))-import Control.Monad (when) import Data.Generics.Labels ()+import Data.Maybe (fromMaybe) 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.InstallClosure (installClosure) import Seihou.CLI.InstallHistory (HistoryEntry (..), InstallHistory (..), readHistory, recordUrl) import Seihou.CLI.InstallShared-  ( InstallOutcome (..),-    cloneRepo,+  ( cloneRepo,     copyDirectoryRecursive,-    formatInstallRefusal,     formatRecordedSourceNotice,     installModuleDir,     recordedSourceUrl,     resolveRecordedSource,   )-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.Registry (EntryKind (..), Registry (..), RegistryEntry (..), RepoContents (..), discoverRepoContents) import Seihou.Core.Types-import Seihou.Dhall.Eval (evalAgentPromptFromFile, evalBlueprintFromFile, evalModuleFromFile, evalRegistryFromFile)+import Seihou.Dhall.Eval (evalRegistryFromFile) import Seihou.Effect.Fzf (selectOne) import Seihou.Effect.FzfInterp (runFzfIO)-import Seihou.Effect.Logger (logError, logWarn)+import Seihou.Effect.Logger (logError) 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)+import Text.Read (readMaybe)  handleInstall :: InstallOpts -> IO () handleInstall iopts = do@@ -69,40 +63,22 @@         exitFailure       Right () -> TIO.putStrLn "  Cloned repository" -    -- Determine what the repo contains     contents <- discoverRepoContents evalRegistryFromFile cloneDir-    case contents of+    roots <- case contents of+      MultiModule registry -> do+        selected <- selectModules iopts registry+        pure [(e ^. #name . #unModuleName, cloneDir </> (e ^. #path)) | e <- selected]       EmptyRepo -> do-        logIO LogNormal (logError "repository contains neither seihou-registry.dhall nor a supported runnable Dhall file.")+        TIO.putStrLn "No supported artifact or registry found."         exitFailure-      SingleModule rootDir -> do-        when (not (null (iopts ^. #modules)) || iopts ^. #all) $-          logIO LogNormal (logWarn "--module and --all flags are ignored for single-module repositories.")-        installSingleModule iopts rootDir source recorded Nothing-      SingleRecipe rootDir -> do-        when (not (null (iopts ^. #modules)) || iopts ^. #all) $-          logIO LogNormal (logWarn "--module and --all flags are ignored for single-recipe repositories.")-        installSingleRecipe iopts rootDir source recorded-      SingleBlueprint rootDir -> do-        when (not (null (iopts ^. #modules)) || iopts ^. #all) $-          logIO LogNormal (logWarn "--module and --all flags are ignored for single-blueprint repositories.")-        installSingleBlueprint iopts rootDir source recorded-      SinglePrompt rootDir -> do-        when (not (null (iopts ^. #modules)) || iopts ^. #all) $-          logIO LogNormal (logWarn "--module and --all flags are ignored for single-prompt repositories.")-        installSinglePrompt iopts rootDir source recorded-      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 recorded+      _ -> pure [(fromMaybe (T.pack repoName) (iopts ^. #name), cloneDir)]+    if null roots+      then TIO.putStrLn "No entries selected."+      else do+        result <- installClosure (iopts ^. #force) cloneDir recorded roots+        case result of+          Left err -> TIO.putStrLn err >> exitFailure+          Right () -> pure ()    -- Record URL in history for future recall (only reached on success)   recordUrl source@@ -168,172 +144,6 @@       TIO.putStrLn "Invalid selection."       exitFailure --- | Install a single-module repo (legacy behavior).-installSingleModule :: InstallOpts -> FilePath -> Text -> Text -> Maybe Text -> IO ()-installSingleModule iopts rootDir source recorded registryName = do-  let name = case iopts ^. #name 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"--  outcome <- installModuleDir (iopts ^. #force) rootDir name recorded registryName (modul ^. #version) []-  reportSingleInstall name recorded outcome-  TIO.putStrLn ""-  TIO.putStrLn $ "Module available as: " <> T.pack name---- | Install a single-recipe repo.-installSingleRecipe :: InstallOpts -> FilePath -> Text -> Text -> IO ()-installSingleRecipe iopts rootDir source recorded = do-  let name = case iopts ^. #name of-        Just n -> T.unpack n-        Nothing -> parseModuleName source--  -- Validate recipe.dhall exists (discoverRepoContents already confirmed it)-  TIO.putStrLn "  Validated recipe definition"--  outcome <- installModuleDir (iopts ^. #force) rootDir name recorded Nothing Nothing []-  reportSingleInstall name recorded outcome-  TIO.putStrLn ""-  TIO.putStrLn $ "Recipe available as: " <> T.pack name---- | Install a single-blueprint repo.-installSingleBlueprint :: InstallOpts -> FilePath -> Text -> Text -> IO ()-installSingleBlueprint iopts rootDir source recorded = do-  let name = case iopts ^. #name 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 = (bp ^. #version)-  outcome <- installModuleDir (iopts ^. #force) rootDir name recorded Nothing bpVersion []-  reportSingleInstall name recorded outcome-  TIO.putStrLn ""-  TIO.putStrLn $ "Blueprint available as: " <> T.pack name---- | Install a single-prompt repo.-installSinglePrompt :: InstallOpts -> FilePath -> Text -> Text -> IO ()-installSinglePrompt iopts rootDir source recorded = do-  let name = case iopts ^. #name 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"--  outcome <- installModuleDir (iopts ^. #force) rootDir name recorded Nothing (prompt ^. #version) []-  reportSingleInstall name recorded outcome-  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 (iopts ^. #force) 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 "")-          <> "."-      -- A batch runs to completion before it reports, so a user installing-      -- twenty entries sees every refusal and every load failure at once-      -- rather than stopping at the first. But a batch that did not fully-      -- succeed must not exit zero: a caller in a script would otherwise-      -- treat a half-applied install as done.-      when (failed > 0) exitFailure---- | Report one single-artifact install. A refusal is fatal here: the command--- was asked to install exactly one thing and did not.-reportSingleInstall :: String -> Text -> InstallOutcome -> IO ()-reportSingleInstall _ _ InstallPerformed = pure ()-reportSingleInstall name source (InstallRefused collision) = do-  TIO.putStrLn ""-  TIO.putStrLn (formatInstallRefusal name source collision)-  exitFailure---- | Report one registry-batch install, returning whether it succeeded. A--- refusal is not fatal here: the remaining entries are still attempted, and--- 'installFromRegistry' exits nonzero once it has reported them all.-reportRegistryInstall :: String -> Text -> InstallOutcome -> Text -> IO Bool-reportRegistryInstall _ _ InstallPerformed successLine = do-  TIO.putStrLn successLine-  pure True-reportRegistryInstall name source (InstallRefused collision) _ = do-  TIO.putStrLn (formatInstallRefusal name source collision)-  pure False- -- | All registry entries (modules, recipes, blueprints, prompts) in display order. -- Used wherever installation must treat all four kinds uniformly. allEntries :: Registry -> [RegistryEntry]@@ -450,94 +260,3 @@               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 :: Bool -> FilePath -> Text -> Text -> RegistryEntry -> IO Bool-installRegistryEntry force 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)-              outcome <- installModuleDir force entryDir name source (Just repoName) ver (entry ^. #tags)-              reportRegistryInstall name source outcome ("    Installed as: " <> T.pack name)-    else do-      hasRecipe <- doesFileExist recipeDhall-      if hasRecipe-        then do-          outcome <- installModuleDir force entryDir name source (Just repoName) (entry ^. #version) (entry ^. #tags)-          reportRegistryInstall name source outcome ("    Installed recipe as: " <> T.pack name)-        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 = (bp ^. #version)-                      ver = entry ^. #version <|> bpVersion-                  outcome <- installModuleDir force entryDir name source (Just repoName) ver (entry ^. #tags)-                  reportRegistryInstall name source outcome ("    Installed blueprint as: " <> T.pack name)-            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)-                          outcome <- installModuleDir force entryDir name source (Just repoName) ver (entry ^. #tags)-                          reportRegistryInstall name source outcome ("    Installed prompt as: " <> T.pack name)-                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/NewRecipe.hs view
@@ -49,6 +49,10 @@   TIO.putStrLn $ "Created " <> T.pack (outputDir </> "recipe.dhall")    TIO.putStrLn $ "Recipe '" <> name <> "' created at " <> T.pack outputDir <> "/"+  TIO.putStrLn $ "Next: seihou validate-recipe " <> "'" <> T.replace "'" "'\"'\"'" (T.pack outputDir) <> "'"+  if null (ropts ^. #modules)+    then TIO.putStrLn "Add at least one member to modules before validating."+    else pure ()  -- | Check if a recipe name matches [a-z][a-z0-9-]* isValidRecipeName :: Text -> Bool
src-exe/Seihou/CLI/Run.hs view
@@ -44,13 +44,13 @@   ( detectPendingMigrations,     formatRefusalMessage,   )-import Seihou.CLI.SavePrompted (collectPromptedValues, offerSavePrompted)+import Seihou.CLI.SavePrompted (collectRecipePromptedValues, offerSavePrompted) import Seihou.CLI.Shared (deriveNamespace, formatBlueprintRefusal, formatVarError, logIO, resolveAppliedArtifactDir, toVarNameMap, unwrapConfig) import Seihou.CLI.Style (bold, dim, formatPlanViewColor, green, magenta, red, useColor, yellow) import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName) import Seihou.Composition.Plan (ComposedPlan (..), compileComposedPlan) import Seihou.Composition.Recipe (expandRecipe)-import Seihou.Composition.Resolve (loadComposition, resolveWithPrompts)+import Seihou.Composition.Resolve (PromptPermission (..), RecipeInputSpec (..), loadComposition, resolveRecipeWithPrompts, verifyDependencySources) import Seihou.Core.Application (attachApplication, buildAppliedComposition, mkApplicationId, replaceAppliedComposition) import Seihou.Core.ArtifactOriginDetect (detectArtifactOrigin) import Seihou.Core.ArtifactRef (renderArtifactRefError)@@ -122,7 +122,7 @@    -- 0b. Recipe detection: check if the name resolves to a recipe or a module   searchPaths <- defaultSearchPaths-  (primaryName, allAdditional, recipeOverrides, recipeInfo, targetInfo) <- do+  (primaryName, allAdditional, recipeOverrides, recipeDecls, recipePrompts, recipeInfo, targetInfo) <- do     runnableResult <- discoverRunnable searchPaths modName     case runnableResult of       Right (RunnableRecipe recipe recipeDir) -> do@@ -135,7 +135,11 @@                   <> "': "                   <> T.intercalate "; " errs             exitFailure-          Right (primary, recipeAdditional, overrides, _recipeVars, _recipePrompts) -> do+          Right (primary, recipeAdditional, overrides, recipeVars, recipePrompts, requirements) -> do+            sourceCheck <- verifyDependencySources searchPaths recipeDir requirements+            case sourceCheck of+              Left err -> TIO.putStrLn (T.pack (show err)) >> exitFailure+              Right () -> pure ()             logIO level $               logInfo $                 "Recipe '" <> recipe ^. #name . #unRecipeName <> "' expanding to " <> T.pack (show (length (recipe ^. #modules))) <> " modules"@@ -143,6 +147,8 @@               ( primary,                 recipeAdditional ++ additional,                 overrides,+                recipeVars,+                recipePrompts,                 Just (recipe ^. #name, recipe ^. #version),                 (AppliedRecipeTarget (recipe ^. #name), recipeDir, recipe ^. #version)               )@@ -151,6 +157,8 @@           ( modName,             additional,             Map.empty,+            [],+            [],             Nothing,             (AppliedModuleTarget modName, moduleDir, modul ^. #version)           )@@ -167,6 +175,8 @@           ( modName,             additional,             Map.empty,+            [],+            [],             Nothing,             (AppliedModuleTarget modName, "", Nothing)           )@@ -197,8 +207,7 @@   -- 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 ^. #vars]) recipeOverrides-      envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]+  let envVars = Map.fromList [(T.pack k, T.pack v) | (k, v) <- envPairs]       namespace = fromMaybe (deriveNamespace primaryName) (runOpts ^. #namespace)   context <- resolveContext (runOpts ^. #context) envVars   let contextName = fromMaybe "" context@@ -211,9 +220,9 @@         nm = toVarNameMap namespaceCfg         cm = toVarNameMap contextCfg         gm = toVarNameMap globalCfg-    r <- resolveWithPrompts modulesInOrder cliOverrides envVars namespace contextName lm nm cm gm+    r <- resolveRecipeWithPrompts PromptsAllowed (runOpts ^. #confirmDefaults) (RecipeInputSpec recipeDecls recipePrompts Nothing) modulesInOrder Map.empty (Map.fromList [(VarName k, v) | (k, v) <- runOpts ^. #vars]) recipeOverrides envVars namespace contextName lm nm cm gm     pure (r, lm, nm, cm, gm)-  resolvedInitial <- case resolveResult of+  (recipeResolved, resolvedInitial) <- case resolveResult of     Left errs -> do       logIO level $ do         logError "Error resolving variables:"@@ -224,12 +233,12 @@   -- 2a. Optionally confirm default-sourced values.   resolved <-     if runOpts ^. #confirmDefaults-      then runEff $ runConsole $ confirmDefaults modulesInOrder resolvedInitial+      then runEff $ runConsole $ confirmDefaults [(i, m & #vars %~ filter (\d -> not (Map.member (d ^. #name) recipeResolved)), dir) | (i, m, dir) <- 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]+  let allDecls = recipeDecls ++ concatMap (\(_, m, _) -> m ^. #vars) modulesInOrder+      allResolved = Map.union recipeResolved (Map.unions [vs | vs <- Map.elems resolved])       (unusedKeys, _) = diagnoseResolution allResolved allDecls localMap nsMap ctxMap globalMap   when (not (null unusedKeys)) $     logIO level $@@ -342,8 +351,9 @@       candidateCommandReceipts =         finalizeCommandReceipts commandPlan [] priorCommandReceipts +  let recordedRecipe = fmap (const (Map.map (varValueToText . (^. #value)) recipeResolved)) recipeInfo   let declarationApplication =-        buildAppliedComposition appliedTarget targetOrigin targetVersion additional (Just namespace) context originedModules resolved now+        buildAppliedComposition appliedTarget targetOrigin targetVersion additional (Just namespace) context originedModules resolved now & #recipeInputs .~ recordedRecipe   let selectedSeedPaths = Set.fromList [path | (path, receipt) <- Map.toAscList (manifest ^. #seeds), case receipt ^. #ownership of LegacySeedOwners apps -> Set.member currentApplicationId apps || Map.member path seedOwnerMap; _ -> False]   seedPrepared <- prepareRecordedSeedOwnership projectRoot searchPaths selectedSeedPaths manifest   seedBase <- case seedPrepared of@@ -383,8 +393,9 @@    let modNames = map (\(_, m, _) -> m ^. #name) modulesInOrder       allVarValues =-        Map.unions-          [Map.map (^. #value) vs | vs <- Map.elems resolved]+        Map.union (Map.map (^. #value) recipeResolved) $+          Map.unions+            [Map.map (^. #value) vs | vs <- Map.elems resolved]       preview = buildPreview (filter (\case SeedFileOp {} -> False; _ -> True) opsFiltered) (Just diff) ownerMap    -- 6. Handle --dry-run: show plan view and exit@@ -491,6 +502,8 @@                                         now                                     appliedComposition =                                       ( appliedCompositionWithoutReceipts+                                          & #recipeInputs+                                          .~ recordedRecipe                                           & #commandReceipts                                           .~ candidateCommandReceipts                                           & #checkoutCommands@@ -657,7 +670,7 @@                     logIO level (logDebug "--commit: not inside a git repository, skipping.")                -- Offer to save prompted values to local config-              let prompted = collectPromptedValues resolved localMap+              let prompted = collectRecipePromptedValues recipeResolved resolved localMap               when (not (null prompted)) $                 runEff $                   runConfigWriter $
+ src-exe/Seihou/CLI/ValidateRecipe.hs view
@@ -0,0 +1,38 @@+module Seihou.CLI.ValidateRecipe (handleValidateRecipe) where++import Control.Exception (IOException, displayException, try)+import Control.Lens ((^.))+import Data.Generics.Labels ()+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.Commands (ValidateRecipeOpts (..))+import Seihou.CLI.ValidateRecipeReport (recipeLoadErrorText)+import Seihou.Core.Recipe (validateRecipe)+import Seihou.Dhall.Eval (evalRecipeFromFile)+import System.Directory (doesFileExist, getCurrentDirectory)+import System.Exit (ExitCode (..), exitWith)+import System.FilePath ((</>))++handleValidateRecipe :: ValidateRecipeOpts -> IO ()+handleValidateRecipe opts = do+  dir <- maybe getCurrentDirectory pure (opts ^. #path)+  let descriptor = dir </> "recipe.dhall"+      invalid :: [Text] -> Int -> IO a+      invalid errors code = do+        TIO.putStrLn $ "Recipe is invalid: " <> T.pack descriptor+        mapM_ (TIO.putStrLn . ("  " <>)) errors+        exitWith (ExitFailure code)+  checked <- try (doesFileExist descriptor)+  exists <- case checked of+    Left (err :: IOException) -> invalid ["Cannot inspect recipe.dhall: " <> T.pack (displayException err)] 1+    Right value -> pure value+  if not exists+    then invalid ["recipe.dhall not found. Choose a directory containing recipe.dhall."] 4+    else do+      decoded <- evalRecipeFromFile descriptor+      case decoded of+        Left err -> invalid [recipeLoadErrorText err] 1+        Right recipe -> case validateRecipe recipe of+          Left errors -> invalid errors 1+          Right valid -> TIO.putStrLn $ "Recipe '" <> valid ^. #name . #unRecipeName <> "' is valid."
src/Seihou/CLI/AgentCompletion.hs view
@@ -18,6 +18,9 @@     buildBaikaiModel,     runAgentCompletion,     runAgentCompletionWithCliAccess,+    runAgentMigrationCompletionWithCliAccess,+    resolveAgentInitialPrompt,+    migrationAllowedTools,     runAgentCompletionWith,     responseText,   )@@ -34,15 +37,20 @@ import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel) import Baikai.Trace qualified as BaikaiTrace import Baikai.Trace.Sink (TraceSink, silent)-import Control.Exception (try)+import Control.Exception (IOException, throwIO, try) import Control.Lens ((&), (.~), (^.)) import Data.Generics.Labels ()+import Data.List (nub) import Data.Text (Text) import Data.Text qualified as Text+import Data.Text.Encoding qualified as TE import Data.Vector qualified as V import GHC.Generics (Generic)+import Seihou.CLI.AgentMigrationProtocol (validateMigrationOutput) import Seihou.CLI.KitConfig (seihouKitConfig) import System.Directory (getCurrentDirectory)+import System.Exit (ExitCode (..))+import System.Process qualified as Process  data AgentProvider   = AgentProviderClaudeCli@@ -258,13 +266,16 @@ -- register. Exported so tests can install a stub provider in place of a real -- one; production callers should use one of the two wrappers. runAgentCompletionWith :: IO () -> AgentCompletionRequest -> IO (Either Text Text)-runAgentCompletionWith registerProviders req = do+runAgentCompletionWith = runAgentCompletionUsing (Text.pack . show)++runAgentCompletionUsing :: (Baikai.BaikaiError -> Text) -> IO () -> AgentCompletionRequest -> IO (Either Text Text)+runAgentCompletionUsing renderError registerProviders req = do   registerProviders   initialMessages <-     maybe       (pure V.empty)       (fmap V.singleton . Baikai.userNow)-      (req ^. #initialPrompt)+      (resolveAgentInitialPrompt (req ^. #modelConfig . #provider) (req ^. #initialPrompt))   let model = buildBaikaiModel (req ^. #modelConfig)       ctx =         Baikai.emptyContext@@ -279,7 +290,7 @@     -- Retained deliberately. 'withTrace' does not throw for provider failures,     -- but its doc comment states that downstream-of-the-fold exceptions still     -- propagate — an unwritable trace path, for instance.-    Left err -> Left (Text.pack (show err))+    Left err -> Left (renderError err)     Right resp -> case BaikaiResponse.responseError resp of       -- 'withTrace' surfaces a provider failure as an error-shaped Response       -- rather than an exception, and such a response has no assistant text.@@ -288,7 +299,7 @@       -- below and be reported as "Provider returned no assistant text.",       -- losing the message the user needs. Formatting matches the exception       -- branch exactly, so the text a user sees is what it always was.-      Just err -> Left (Text.pack (show err))+      Just err -> Left (renderError err)       Nothing ->         let body = responseText resp          in if Text.null (Text.strip body)@@ -345,3 +356,89 @@ codexAccessArgs extraDirs =   ["--sandbox", "workspace-write"]     <> concatMap (\dir -> ["--add-dir", Text.pack dir]) extraDirs++-- | CLI transports need a user turn even when all instructions live in the+-- system prompt. Preserve explicit instructions and API semantics.+resolveAgentInitialPrompt :: AgentProvider -> Maybe Text -> Maybe Text+resolveAgentInitialPrompt provider prompt = case provider of+  AgentProviderClaudeCli -> cliPrompt+  AgentProviderCodexCli -> cliPrompt+  AgentProviderAnthropic -> prompt+  AgentProviderOpenAI -> prompt+  where+    cliPrompt = case prompt of+      Just value | not (Text.null (Text.strip value)) -> prompt+      _ -> Just "Follow the instructions in the system prompt."++-- | A migration must retain raw process/protocol failures until classification.+-- Register this narrow adapter behind the usual trace wrapper, so it emits to+-- the command's existing sink and ordinary completion callers remain unchanged.+runAgentMigrationCompletionWithCliAccess :: [FilePath] -> [String] -> AgentCompletionRequest -> IO (Either Text Text)+runAgentMigrationCompletionWithCliAccess dirs tools req =+  case req ^. #modelConfig . #provider of+    AgentProviderClaudeCli -> runAgentCompletionUsing (^. #message) (registerStrict Baikai.AnthropicMessagesCli) req+    AgentProviderCodexCli -> runAgentCompletionUsing (^. #message) (registerStrict Baikai.OpenAICompletionsCli) req+    _ -> runAgentCompletion req+  where+    registerStrict api = do+      cwd <- getCurrentDirectory+      sessionArgs <- KitSession.codexSessionArgs seihouKitConfig+      let complete m ctx options = do+            let (exe, args) = case req ^. #modelConfig . #provider of+                  AgentProviderClaudeCli ->+                    ClaudeCli.claudeCliCommand+                      (ClaudeCli.defaultClaudeCliConfig {ClaudeCli.extraArgs = ["--permission-mode", "acceptEdits"] <> claudeAccessArgs dirs (migrationAllowedTools tools)})+                      m+                      ctx+                      options+                  _ ->+                    CodexCli.codexCliCommand+                      (CodexCli.defaultCodexCliConfig {CodexCli.extraArgs = codexAccessArgs dirs <> sessionArgs})+                      m+                      ctx+                      options+            attempted <-+              try+                ( Process.readCreateProcessWithExitCode+                    ((Process.proc exe args) {Process.cwd = Just cwd, Process.create_group = True})+                    ""+                ) ::+                IO (Either IOException (ExitCode, String, String))+            let result = case attempted of+                  Left err -> Left ("Could not start " <> Text.pack exe <> ": " <> Text.pack (show err) <> ". Check installation and authentication, then retry.")+                  Right (code, out, err) -> case code of+                    ExitFailure n -> Left (Text.pack exe <> " exited " <> Text.pack (show n) <> ": " <> Text.take 2000 (Text.pack err <> Text.pack out) <> ". Inspect partial edits, fix the provider error, then retry.")+                    ExitSuccess -> validateMigrationOutput (req ^. #modelConfig . #provider == AgentProviderClaudeCli) (TE.encodeUtf8 (Text.pack out))+            case result of+              Left err -> throwIO (Baikai.providerError err)+              Right body ->+                pure $+                  BaikaiResponse.emptyResponse+                    { BaikaiResponse.model = m,+                      BaikaiResponse.message =+                        Baikai.AssistantPayload+                          { Baikai.content = V.singleton (Baikai.AssistantText (Baikai.TextContent body)),+                            Baikai.usage = Baikai.zeroUsage,+                            Baikai.stopReason = Baikai.Stop,+                            Baikai.errorMessage = Nothing,+                            Baikai.timestamp = Nothing+                          }+                    }+      Baikai.registerApiProvider (Baikai.apiProviderWith api (Baikai.liftCompleteToStream complete) complete)++-- | Source discovery is part of the ordinary migration workflow. Keep grants+-- specific to read-only Mori commands; registry writes are never implied.+migrationAllowedTools :: [String] -> [String]+migrationAllowedTools tools =+  nub+    ( tools+        <> [ "Bash(mori registry list)",+             "Bash(mori registry list *)",+             "Bash(mori registry search *)",+             "Bash(mori registry show *)",+             "Bash(mori registry docs *)",+             "Bash(mori registry dependents *)",+             "Bash(mori path *)",+             "Bash(head *)"+           ]+    )
+ src/Seihou/CLI/AgentMigrationProtocol.hs view
@@ -0,0 +1,85 @@+-- | Strict validation before a migration may create a receipt. Unknown fields+-- are compatible; corrupt or incomplete evidence is not.+module Seihou.CLI.AgentMigrationProtocol (validateMigrationOutput) where++import Control.Monad (unless, when)+import Data.Aeson (Value (..), eitherDecodeStrict')+import Data.Aeson.KeyMap qualified as KM+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V++validateMigrationOutput :: Bool -> ByteString -> Either Text Text+validateMigrationOutput claude bytes = case validate of+  Left err -> Left (err <> " Inspect partial edits, check provider permissions/protocol support, then retry the same migration.")+  Right body -> Right body+  where+    validate+      | claude = do+          raw <- decodeValue bytes+          value <- case raw of+            Object _ -> Right raw+            Array events | not (V.null events) -> do+              mapM_ checkClaudeEvent (V.toList events)+              Right (V.last events)+            _ -> Left "Claude result is missing."+          require (field "type" value == Just (String "result")) "Claude result is missing."+          require (field "subtype" value == Just (String "success")) ("Claude did not report success. " <> detail value)+          require (field "is_error" value == Just (Bool False)) ("Claude reported an error or omitted is_error. " <> detail value)+          case field "permission_denials" value of+            Just (Array denials) | V.null denials -> pure ()+            _ -> Left ("Claude reported permission denials or omitted permission evidence. " <> detail value)+          textField "result" value >>= nonblank+      | otherwise = do+          events <- traverse decode (filter (not . BS.null) (BS.lines bytes))+          mapM_ checkEvent events+          require (any (\event -> field "type" event == Just (String "turn.completed")) events) "Codex has no successful terminal turn result."+          let messages = [body | event <- events, field "type" event == Just (String "item.completed"), Just item <- [field "item" event], field "type" item == Just (String "agent_message"), Just (String body) <- [field "text" item]]+          nonblank (T.intercalate "\n" messages)+    detail value = case field "result" value of+      Just (String body) -> T.take 2000 body+      _ -> "Check the Claude CLI authentication and configuration."+    checkEvent event = do+      kind <- textField "type" event+      when (kind `elem` ["error", "turn.failed", "permission_denied"]) (Left "Codex reported an error, failed turn, or permission denial.")+      case field "permission_denials" event of+        Nothing -> pure ()+        Just (Array values) | V.null values -> pure ()+        _ -> Left "Codex reported permission denials."+      when (kind `elem` ["item.completed", "item.started", "item.updated"]) $ do+        item <- maybe (Left "Codex item event omitted item.") Right (field "item" event)+        itemKind <- textField "type" item+        when (itemKind == "error" || field "status" item `elem` [Just (String "declined"), Just (String "failed")]) (Left "Codex reported an item error or permission denial.")+        when (kind == "item.completed" && itemKind == "agent_message") $ do+          _ <- textField "text" item+          pure ()+    checkClaudeEvent event = do+      kind <- textField "type" event+      when (kind == "result" && field "subtype" event /= Just (String "success")) (Left "Claude reported a failed result.")+      case field "permission_denials" event of+        Nothing -> pure ()+        Just (Array values) | V.null values -> pure ()+        _ -> Left ("Claude reported permission denials: " <> deniedTools event <> ". " <> detail event)+      when (field "is_error" event == Just (Bool True) || field "type" event == Just (String "error")) (Left "Claude reported an error.")+    deniedTools event = case field "permission_denials" event of+      Just (Array values) -> T.intercalate ", " [name <> commandDetail value | value <- V.toList values, Just (String name) <- [field "tool_name" value]]+      _ -> "unspecified tool"+    commandDetail value = case field "tool_input" value >>= field "command" of+      Just (String command) -> " (" <> T.take 240 command <> ")"+      _ -> ""+    decodeValue raw = case eitherDecodeStrict' raw of+      Left _ -> Left "Malformed migration provider JSON."+      Right value -> Right value+    decode raw = case eitherDecodeStrict' raw of+      Left _ -> Left "Malformed migration provider JSON."+      Right value@(Object _) -> Right value+      Right _ -> Left "Migration provider event must be a JSON object."+    field key (Object object) = KM.lookup key object+    field _ _ = Nothing+    textField key value = case field key value of+      Just (String body) -> Right body+      _ -> Left "Migration provider omitted a required text field."+    require condition err = unless condition (Left err)+    nonblank body = if T.null (T.strip body) then Left "Provider returned no assistant text." else Right body
+ src/Seihou/CLI/InstallClosure.hs view
@@ -0,0 +1,264 @@+-- | Acquisition is completed and validated before any installed entry changes.+module Seihou.CLI.InstallClosure (installClosure, installClosureInto) where++import Control.Exception (IOException, displayException, mask, onException, throwIO, try)+import Control.Monad (forM, forM_, unless, when)+import Data.Generics.Labels ()+import Data.IORef+import Data.List (find)+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.InstallShared+import Seihou.Core.AgentPrompt (validateAgentPrompt)+import Seihou.Core.ArtifactIdentity (normalizeOriginUrl)+import Seihou.Core.Blueprint (validateBlueprintForInstall)+import Seihou.Core.Module (validateModule)+import Seihou.Core.Recipe (validateRecipe)+import Seihou.Core.Registry+import Seihou.Core.Types+import Seihou.Dhall.Eval+import Seihou.Prelude+import System.Directory+import System.FilePath (isAbsolute, makeRelative, splitDirectories)+import System.IO.Temp (createTempDirectory, withSystemTempDirectory)++-- Paths refer to temporary checkouts until every selected root passes preflight.+data Entry = Entry+  { entryName :: !Text,+    entrySource :: !Text,+    entryDir :: !FilePath,+    entryFile :: !FilePath,+    entryVersion :: !(Maybe Text),+    entryRegistry :: !(Maybe Text),+    entryTags :: ![Text],+    entryChain :: !Text+  }+  deriving stock (Generic)++data Repo = Repo FilePath Text RepoContents++-- | Roots are registry entries, or a name and directory for a single artifact.+-- All failures discovered across selected roots are reported before staging.+installClosure :: Bool -> FilePath -> Text -> [(Text, FilePath)] -> IO (Either Text ())+installClosure force rootDir recorded roots = do+  cache <- installedRoot+  installClosureInto cache force rootDir recorded roots++-- | Explicit cache root for isolated callers and concurrent tests.+installClosureInto :: FilePath -> Bool -> FilePath -> Text -> [(Text, FilePath)] -> IO (Either Text ())+installClosureInto cache force rootDir recorded roots = withSystemTempDirectory "seihou-closure" $ \tmp -> do+  repos <- newIORef Map.empty+  contents <- readContents rootDir+  modifyIORef' repos (Map.insert (normalizeOriginUrl recorded) (Repo rootDir recorded contents))+  nodes <- newIORef Map.empty+  ordered <- newIORef []+  let failWith = throwIO . userError . T.unpack+      getRepo source = do+        known <- readIORef repos+        case Map.lookup (normalizeOriginUrl source) known of+          Just repo -> pure repo+          Nothing -> do+            let dir = tmp </> ("repo-" ++ show (Map.size known))+            cloneRepo source dir >>= either failWith pure+            origin <- recordedSourceUrl <$> resolveRecordedSource source+            discovered <- readContents dir+            let repo = Repo dir origin discovered+            modifyIORef' repos (Map.insert (normalizeOriginUrl source) repo . Map.insert (normalizeOriginUrl origin) repo)+            pure repo+      visit active chain repo@(Repo repoDir origin _) name dir mustBeModule = do+        let key = (normalizeOriginUrl origin, name)+            context = chain <> name <> " [" <> origin <> "]"+        unless (safeName name) $ failWith (context <> ": unsafe install name")+        when (key `elem` active) $ failWith (context <> ": dependency cycle")+        known <- readIORef nodes+        case Map.lookup name known of+          Just (other, _) | other /= fst key -> failWith (context <> ": conflicting sources for " <> name <> "; also required from " <> other)+          _ -> pure ()+        checkTree repoDir dir+        (file, deps, version) <- inspect dir mustBeModule `withContext` context+        case Map.lookup name known of+          Just _ -> pure ()+          Nothing -> do+            modifyIORef' nodes (Map.insert name (fst key, context))+            -- Evaluate every declaration independently of generation bindings.+            forM_ deps $ \dep -> do+              let depName = dep ^. #module_ . #unModuleName+              depRepo <- case dep ^. #source of+                Nothing -> pure repo+                Just src -> do+                  when (T.null (T.strip src) || "${" `T.isInfixOf` src) $ failWith (context <> ": invalid dependency source")+                  getRepo src `withContext` context+              depDir <- locate depRepo depName `withContext` context+              visit (key : active) (context <> " -> ") depRepo depName depDir True+            let tags = case repo of+                  Repo _ _ (MultiModule reg) -> maybe [] (^. #tags) (find ((== name) . (^. #name . #unModuleName)) (entries reg))+                  _ -> []+                registry = case repo of+                  Repo _ _ (MultiModule reg) -> Just (reg ^. #repoName)+                  _ -> Nothing+            checkTree repoDir dir+            modifyIORef' ordered (++ [Entry name origin dir file version registry tags context])+      rootRepo = Repo rootDir recorded contents+  outcomes <- forM roots $ \(name, dir) -> try @IOException (visit [] "" rootRepo name dir False)+  let errors = [T.pack (displayException e) | Left e <- outcomes]+  if not (null errors)+    then pure (Left (T.intercalate "\n" errors))+    else do+      planned <- readIORef ordered+      collisions <- forM planned $ \e -> classifyInstallCollision (cache </> T.unpack (e ^. #entryName)) (e ^. #entrySource)+      let refusals = [(e ^. #entryChain) <> "\n" <> formatInstallRefusal (T.unpack (e ^. #entryName)) (e ^. #entrySource) c | (e, c) <- zip planned collisions, blocked c, not force]+      if not (null refusals)+        then pure (Left (T.intercalate "\n" refusals))+        else do+          result <- try @IOException $ do+            -- Normalize all imports before the source checkouts disappear.+            forM_ planned $ \e -> do+              let stage = tmp </> "stage" </> T.unpack (e ^. #entryName)+              createDirectoryIfMissing True stage+              copyDirectoryRecursive (e ^. #entryDir) stage+              normalizePayload (e ^. #entryDir) stage (e ^. #entryFile)+              definition <- normalizeInstalledDefinition (e ^. #entrySource) ((e ^. #entryDir) </> (e ^. #entryFile))+              TIO.writeFile (stage </> (e ^. #entryFile)) definition+            -- Build metadata with the existing writer, entirely outside the cache.+            forM_ planned $ \e -> do+              let name = T.unpack (e ^. #entryName)+              _ <- installModuleDirInto (tmp </> "ready") False (tmp </> "stage" </> name) name (e ^. #entrySource) (e ^. #entryRegistry) (e ^. #entryVersion) (e ^. #entryTags)+              pure ()+            current <- forM planned $ \e -> classifyInstallCollision (cache </> T.unpack (e ^. #entryName)) (e ^. #entrySource)+            unless (current == collisions) $ failWith "Install cache changed during preparation; retry the same install command."+            createDirectoryIfMissing True cache+            -- Keep recovery data on the same filesystem as the destination.+            transaction <- createTempDirectory cache ".seihou-transaction"+            let commit = do+                  changed <- newIORef []+                  let rollback =+                        readIORef changed+                          >>= mapM_+                            ( \(dest, backup, existed) -> do+                                present <- doesDirectoryExist dest+                                when present (removeDirectoryRecursive dest)+                                when existed (renameDirectory backup dest)+                            )+                  mask $ \restore ->+                    ( forM_ (zip planned collisions) $ \(e, c) -> do+                        let name = T.unpack (e ^. #entryName)+                            dest = cache </> name+                            backup = transaction </> name+                        latest <- classifyInstallCollision dest (e ^. #entrySource)+                        unless (latest == c) $ failWith ("Install cache changed for " <> (e ^. #entryName) <> "; retry.")+                        when (blocked c) $ TIO.putStrLn (formatInstallOverride name (e ^. #entrySource) c)+                        exists <- doesDirectoryExist dest+                        when exists (renameDirectory dest backup)+                        modifyIORef' changed ((dest, backup, exists) :)+                        createDirectoryIfMissing True dest+                        restore (copyDirectoryRecursive (tmp </> "ready" </> name) dest)+                    )+                      `onException` rollback+            commit `onException` TIO.putStrLn ("Install failed; any retained recovery data is in " <> T.pack transaction)+            removeDirectoryRecursive transaction+          case result of+            Left e -> pure (Left (T.pack (displayException e)))+            Right () -> do+              forM_ planned $ \e -> TIO.putStrLn $ "  Installed " <> (e ^. #entryName) <> " from " <> (e ^. #entrySource) <> if (e ^. #entryName) `elem` map fst roots then " (selected)" else " (required)"+              TIO.putStrLn $ T.pack (show (length planned)) <> " entries installed; selected artifacts are ready."+              pure (Right ())++withContext :: IO a -> Text -> IO a+withContext action context = do+  result <- try @IOException action+  either (throwIO . userError . ((T.unpack context <> " -> ") <>) . displayException) pure result++blocked :: InstallCollision -> Bool+blocked (DifferentSource _) = True+blocked UnknownSource = True+blocked _ = False++safeName :: Text -> Bool+safeName name = not (T.null name) && name /= "." && name /= ".." && T.all (\c -> c /= '/' && c /= '\\' && c /= '\0') name++entries :: Registry -> [RegistryEntry]+entries reg = reg ^. #modules ++ reg ^. #recipes ++ reg ^. #blueprints ++ reg ^. #prompts++locate :: Repo -> Text -> IO FilePath+locate (Repo dir origin contents) name = case contents of+  MultiModule reg -> case find ((== name) . (^. #name . #unModuleName)) (entries reg) of+    Just entry -> do+      let candidate = dir </> (entry ^. #path)+      checkTree dir candidate+      pure candidate+    Nothing -> missing+  SingleModule _ -> do+    m <- evalModuleFromFile (dir </> "module.dhall") >>= decoded+    if m ^. #name . #unModuleName == name then pure dir else missing+  _ -> missing+  where+    missing = throwIO (userError (T.unpack (name <> " not found as a module in " <> origin)))++-- Reject escapes and symlinks rather than copying files from outside the clone.+checkTree :: FilePath -> FilePath -> IO ()+checkTree root candidate = do+  root' <- canonicalizePath root+  path <- canonicalizePath candidate+  let rel = makeRelative root' path+  when (isAbsolute rel || ".." `elem` splitDirectories rel) $ throwIO (userError ("Artifact path escapes repository: " <> candidate))+  walk candidate+  where+    walk path = do+      link <- pathIsSymbolicLink path+      when link $ throwIO (userError ("Symbolic links are not supported in installed payloads: " <> path))+      dir <- doesDirectoryExist path+      when dir $ listDirectory path >>= mapM_ (\name -> unless (name == ".git") (walk (path </> name)))++decoded :: (Show e) => Either e a -> IO a+decoded = either (throwIO . userError . show) pure++inspect :: FilePath -> Bool -> IO (FilePath, [Dependency], Maybe Text)+inspect dir mustBeModule = do+  hasModule <- doesFileExist (dir </> "module.dhall")+  if hasModule+    then do+      m <- evalModuleFromFile (dir </> "module.dhall") >>= decoded+      _ <- validateModule dir m >>= decoded+      pure ("module.dhall", m ^. #dependencies, m ^. #version)+    else+      if mustBeModule+        then throwIO (userError ("Expected module at " <> dir))+        else do+          recipe <- doesFileExist (dir </> "recipe.dhall")+          blueprint <- doesFileExist (dir </> "blueprint.dhall")+          if recipe+            then do+              r <- evalRecipeFromFile (dir </> "recipe.dhall") >>= decoded+              _ <- decoded (validateRecipe r)+              pure ("recipe.dhall", r ^. #modules, r ^. #version)+            else+              if blueprint+                then do+                  b <- evalBlueprintFromFile (dir </> "blueprint.dhall") >>= decoded+                  _ <- validateBlueprintForInstall dir b >>= decoded+                  pure ("blueprint.dhall", b ^. #baseModules, b ^. #version)+                else do+                  p <- evalAgentPromptFromFile (dir </> "prompt.dhall") >>= decoded+                  _ <- validateAgentPrompt dir p >>= decoded+                  pure ("prompt.dhall", [], p ^. #version)++-- A malformed registry must not silently fall back to a stray root module.+readContents :: FilePath -> IO RepoContents+readContents dir = do+  registry <- doesFileExist (dir </> "seihou-registry.dhall")+  if registry+    then MultiModule <$> (evalRegistryFromFile (dir </> "seihou-registry.dhall") >>= decoded)+    else discoverRepoContents evalRegistryFromFile dir++-- Dhall source files used by generation can also import siblings of an artifact.+normalizePayload :: FilePath -> FilePath -> FilePath -> IO ()+normalizePayload sourceDir stagedDir definition = do+  children <- listDirectory sourceDir+  forM_ children $ \name -> unless (name == ".git" || name == definition) $ do+    let src = sourceDir </> name+        dst = stagedDir </> name+    directory <- doesDirectoryExist src+    if directory+      then normalizePayload src dst ""+      else when (".dhall" `T.isSuffixOf` T.pack name) $ normalizeDhallFile src >>= TIO.writeFile dst
src/Seihou/CLI/SavePrompted.hs view
@@ -1,5 +1,6 @@ module Seihou.CLI.SavePrompted   ( collectPromptedValues,+    collectRecipePromptedValues,     offerSavePrompted,   ) where@@ -21,12 +22,19 @@   Map ModuleInstance (Map VarName ResolvedVar) ->   Map VarName Text ->   [(VarName, Text, Maybe Text)]-collectPromptedValues resolved localConfig =+collectPromptedValues resolved = collectRecipePromptedValues Map.empty resolved++collectRecipePromptedValues ::+  Map VarName ResolvedVar ->+  Map ModuleInstance (Map VarName ResolvedVar) ->+  Map VarName Text ->+  [(VarName, Text, Maybe Text)]+collectRecipePromptedValues recipe resolved localConfig =   let allPrompted =         Map.toAscList $           Map.unions             [ Map.mapMaybe promptedOnly vs-            | vs <- Map.elems resolved+            | vs <- recipe : Map.elems resolved             ]       promptedOnly rv =         case rv ^. #source of
src/Seihou/CLI/SchemaVersion.hs view
@@ -9,11 +9,11 @@  -- | Raw URL for the seihou-schema package.dhall at a pinned commit schemaUrl :: Text-schemaUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/7d02695f5a716384ec2174a018c20ee680ab3d13/package.dhall"+schemaUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/d3c78cd81d9697ebff3128732ec673a17e65c73f/package.dhall"  -- | SHA256 integrity hash for the schema import schemaHash :: Text-schemaHash = "sha256:5a24b98eada6628e3e7da267f4e6c31c1e169179d2bacd5fed7254fc4cc55183"+schemaHash = "sha256:49297b712cb7fd4b38f3d7c7eb41f34685638e306058913e5129a79157e298aa"  -- | Complete Dhall import line for use in generated modules schemaImportLine :: Text
src/Seihou/CLI/Update.hs view
@@ -49,9 +49,11 @@ import Seihou.Composition.Recipe (expandRecipe) import Seihou.Composition.Resolve   ( PromptPermission (..),+    RecipeInputSpec (..),     SavedInstanceValues,     loadComposition,-    resolveWithPromptPermission,+    resolveRecipeWithPrompts,+    verifyDependencySources,   ) import Seihou.Core.Application (buildAppliedComposition, mkApplicationId, replaceAppliedComposition) import Seihou.Core.ArtifactIdentity (sameArtifactIdentity)@@ -277,6 +279,11 @@ -- co-owners are compiled from their recorded state, and the closure is -- enforced again on the certified manifest. Nothing here writes outside the -- session directory, runs a command, or reconciles a co-owner's files.+isRecipeApplication :: AppliedComposition -> Bool+isRecipeApplication app = case app ^. #target of+  AppliedRecipeTarget _ -> True+  _ -> False+ resolveSelection ::   UpdateRequest ->   FilePath ->@@ -290,7 +297,9 @@ resolveSelection request sessionDirectory projectRoot installedDirectory manifestPath document manifest now =   case matchApplications (request ^. #selection) manifest of     Left err -> pure (Left err)-    Right (MatchedAll applications) -> pure (Right (SelectionResolution manifest applications [] Nothing []))+    Right (MatchedAll applications) -> pure $ do+      prepared <- if any isRecipeApplication applications then prepareManifestSchema manifestPath RecipeInputs document manifest else Right manifest+      Right (SelectionResolution prepared applications [] Nothing [])     Right (MatchedLegacy name) -> do       seeded <- seedLegacyApplication request sessionDirectory projectRoot installedDirectory manifest now name       case seeded of@@ -300,7 +309,7 @@           included <- includeLegacyDependencies request projectRoot manifest now applications staged           pure (fmap (\(allApplications, next, additions) -> SelectionResolution manifest allApplications (warnings <> additions) (Just next) []) included)     Right (MatchedNamed named) ->-      case prepareManifestSchema manifestPath TargetedAdditiveSharedPathUpdate document manifest of+      case prepareManifestSchema manifestPath (if any isRecipeApplication (applicationsWithIds manifest named) then RecipeInputs else TargetedAdditiveSharedPathUpdate) document manifest of         Left err -> pure (Left err)         Right prepared -> closeOver (1 :: Int) prepared Nothing [] named   where@@ -547,7 +556,7 @@     Left err -> pure (Left err)     Right (primary, recipeAdditional, recipeOverrides, targetArtifact) -> do       let allAdditional = recipeAdditional <> (previous ^. #additionalModules)-      loaded <- loadComposition (catalog ^. #searchRoot : fallback) primary allAdditional+      loaded <- loadCandidateComposition (catalog ^. #searchRoot : fallback) targetArtifact primary allAdditional       case loaded of         Left err -> pure (Left (CandidateLoadFailed (primary ^. #unModuleName) err))         Right modulesInOrder -> do@@ -556,10 +565,10 @@                 | otherwise = savedInstanceValues previous               namespace = fromMaybe (deriveNamespace primary) (previous ^. #namespace)               context = fromMaybe "" (previous ^. #context)-          resolved <- resolveApplicationValues request namespace context savedValues recipeOverrides modulesInOrder+          resolved <- resolveApplicationValues request namespace context savedValues (artifactRecipeInputs targetArtifact (if request ^. #reconfigure then Nothing else previous ^. #recipeInputs)) recipeOverrides modulesInOrder           case resolved of             Left err -> pure (Left err)-            Right resolvedValues -> do+            Right (recipeValues, resolvedValues) -> do               compiled <-                 compileComposedPlan                   [ (instanceId, modul, directory, Map.map (^. #value) (resolvedValues Map.! instanceId))@@ -583,6 +592,8 @@                           originedModules                           resolvedValues                           now+                          & #recipeInputs+                          .~ recordedRecipeInputs (previous ^. #target) recipeValues                           & #checkoutCommands                           .~ checkoutCommandsFromOperations operations                           & #applicationId@@ -624,29 +635,38 @@   AppliedRecipeTarget name -> do     artifact <- lookupArtifact catalog CandidateRecipe (name ^. #unRecipeName)     recipe <- maybe (Left (CandidateArtifactMissing CandidateRecipe (name ^. #unRecipeName))) Right (artifact ^. #recipeDefinition)-    (primary, additional, overrides, _, _) <- first (CandidateRepositoryInvalid (name ^. #unRecipeName)) (expandRecipe recipe)+    (primary, additional, overrides, _, _, _) <- first (CandidateRepositoryInvalid (name ^. #unRecipeName)) (expandRecipe recipe)     Right (primary, additional, overrides, artifact)  lookupArtifact :: CandidateCatalog -> CandidateArtifactKind -> Text -> Either UpdateError CandidateArtifact lookupArtifact catalog kind name =   maybe (Left (CandidateArtifactMissing kind name)) Right (Map.lookup (kind, name) (catalog ^. #artifacts)) +recordedRecipeInputs :: AppliedTarget -> Map VarName ResolvedVar -> Maybe (Map VarName Text)+recordedRecipeInputs (AppliedRecipeTarget _) values = Just (Map.map (varValueToText . (^. #value)) values)+recordedRecipeInputs _ _ = Nothing++artifactRecipeInputs :: CandidateArtifact -> Maybe (Map VarName Text) -> RecipeInputSpec+artifactRecipeInputs artifact saved = case artifact ^. #recipeDefinition of+  Just recipe -> RecipeInputSpec (recipe ^. #vars) (recipe ^. #prompts) saved+  Nothing -> RecipeInputSpec [] [] saved+ resolveApplicationValues ::   UpdateRequest ->   Text ->   Text ->   SavedInstanceValues ->+  RecipeInputSpec ->   Map VarName Text ->   [(ModuleInstance, Module, FilePath)] ->-  IO (Either UpdateError (Map ModuleInstance (Map VarName ResolvedVar)))-resolveApplicationValues request namespace context saved recipeOverrides modulesInOrder = do+  IO (Either UpdateError (Map VarName ResolvedVar, Map ModuleInstance (Map VarName ResolvedVar)))+resolveApplicationValues request namespace context saved recipeSpec recipeOverrides modulesInOrder = do   envPairs <- getEnvironment   configs <- loadConfigMaps namespace context   case configs of     Left err -> pure (Left err)     Right (localConfig, namespaceConfig, contextConfig, globalConfig) -> do       let cli = Map.fromList [(VarName name, value) | (name, value) <- request ^. #varOverrides]-          overrides = Map.union cli recipeOverrides           env = Map.fromList [(T.pack key, T.pack value) | (key, value) <- envPairs]           promptPermission = case request ^. #promptPolicy of             AllowPrompts -> PromptsAllowed@@ -654,11 +674,14 @@       result <-         runEff $           runConsole $-            resolveWithPromptPermission+            resolveRecipeWithPrompts               promptPermission+              False+              recipeSpec               modulesInOrder               saved-              overrides+              cli+              recipeOverrides               env               namespace               context@@ -688,26 +711,26 @@ seedLegacyApplication request session projectRoot installed manifest now requested = case roots of   [] -> fmap (fmap (\(apps, warnings) -> (apps, warnings, Nothing))) (seedInstalledLegacyApplication request projectRoot manifest now requested)   (target, origin, version) : _ -> do-    let provisional = AppliedComposition (mkApplicationId target []) target origin version [] (Just (deriveNamespace (ModuleName requested))) Nothing [] Map.empty [] now+    let provisional = AppliedComposition (mkApplicationId target []) target origin version [] (Just (deriveNamespace (ModuleName requested))) Nothing [] Map.empty [] Nothing now     staged <- stageCandidateSources (session </> "legacy-candidate") projectRoot installed [provisional]     case staged of       Left err -> pure (Left err)       Right (catalog, sourceWarnings) -> case candidateRoot catalog provisional of         Left err -> pure (Left err)-        Right (primary, additional, overrides, _) -> do+        Right (primary, additional, overrides, artifact) -> do           paths <- defaultSearchPaths-          loaded <- loadComposition (catalog ^. #searchRoot : paths) primary additional+          loaded <- loadCandidateComposition (catalog ^. #searchRoot : paths) artifact primary additional           case loaded of             Left err -> pure (Left (CandidateLoadFailed requested err))             Right modulesInOrder -> do               let (saved, legacyWarnings) = legacySavedValues manifest modulesInOrder                   namespace = deriveNamespace primary-              resolved <- resolveApplicationValues request namespace "" saved overrides modulesInOrder+              resolved <- resolveApplicationValues request namespace "" saved (artifactRecipeInputs artifact Nothing) overrides modulesInOrder               case resolved of                 Left err -> pure (Left err)-                Right values -> do+                Right (recipeValues, values) -> do                   origined <- traverse (withInstanceOrigin projectRoot catalog) modulesInOrder-                  let recorded = buildAppliedComposition target origin version additional (Just namespace) Nothing origined values now & #instances %~ map (restoreLegacyVersion manifest)+                  let recorded = buildAppliedComposition target origin version additional (Just namespace) Nothing origined values now & #recipeInputs .~ recordedRecipeInputs target recipeValues & #instances %~ map (restoreLegacyVersion manifest)                   planned <- planApplication request projectRoot catalog now recorded                   pure $ do                     candidate <- planned@@ -728,29 +751,37 @@       let root = case runnable of             RunnableModule modul directory -> Right (AppliedModuleTarget (modul ^. #name), modul ^. #name, [], Map.empty, directory, modul ^. #version)             RunnableRecipe recipe directory -> do-              (primary, additional, overrides, _, _) <- first (CandidateRepositoryInvalid requested) (expandRecipe recipe)+              (primary, additional, overrides, _, _, _) <- first (CandidateRepositoryInvalid requested) (expandRecipe recipe)               Right (AppliedRecipeTarget (recipe ^. #name), primary, additional, overrides, directory, recipe ^. #version)             _ -> Left (CandidateArtifactMissing CandidateModule requested)       case root of         Left err -> pure (Left err)         Right (target, primary, additional, recipeOverrides, targetSource, targetVersion) -> do-          loaded <- loadComposition searchPaths primary additional+          checked <- case runnable of+            RunnableRecipe recipe directory -> verifyDependencySources searchPaths directory (recipe ^. #modules)+            _ -> pure (Right ())+          loaded <- case checked of+            Left err -> pure (Left err)+            Right () -> loadComposition searchPaths primary additional           case loaded of             Left err -> pure (Left (CandidateLoadFailed requested err))             Right modulesInOrder -> do               let (saved, warnings) = legacySavedValues manifest modulesInOrder                   namespace = deriveNamespace primary-              resolved <- resolveApplicationValues request namespace "" saved recipeOverrides modulesInOrder+              let recipeSpec = case runnable of+                    RunnableRecipe r _ -> RecipeInputSpec (r ^. #vars) (r ^. #prompts) Nothing+                    _ -> RecipeInputSpec [] [] Nothing+              resolved <- resolveApplicationValues request namespace "" saved recipeSpec recipeOverrides modulesInOrder               case resolved of                 Left err -> pure (Left err)-                Right resolvedValues -> do+                Right (recipeValues, resolvedValues) -> do                   targetOrigin <- detectArtifactOrigin projectRoot targetSource                   originedModules <-                     traverse                       (\(instanceId, modul, directory) -> (instanceId,modul,) <$> detectArtifactOrigin projectRoot directory)                       modulesInOrder                   let provisional0 =-                        buildAppliedComposition target targetOrigin targetVersion [] (Just namespace) Nothing originedModules resolvedValues now+                        buildAppliedComposition target targetOrigin targetVersion [] (Just namespace) Nothing originedModules resolvedValues now & #recipeInputs .~ recordedRecipeInputs target recipeValues                       provisional =                         ( provisional0                             & #instances@@ -980,27 +1011,37 @@             | (instanceId, values) <- Map.toList candidateValues,               (name, value) <- Map.toList values             ]-          reusedCount = length [() | (_, _, value) <- resolvedList, value ^. #source == FromApplication]+          moduleKeys = Set.unions (map Map.keysSet (Map.elems prior) <> map Map.keysSet (Map.elems candidateValues))+          recipeOnly = Map.withoutKeys (fromMaybe Map.empty (application ^. #candidate . #recipeInputs)) moduleKeys+          oldRecipeOnly = Map.withoutKeys (fromMaybe Map.empty (application ^. #previous >>= (^. #recipeInputs))) moduleKeys+          recipeReused = Map.size (Map.intersectionWith (==) recipeOnly oldRecipeOnly & Map.filter id)+          recipeChanged = Map.size (Map.intersection recipeOnly oldRecipeOnly) - recipeReused+          recipeNew = Map.size (Map.difference recipeOnly oldRecipeOnly)+          recipeRemoved = Map.size (Map.difference oldRecipeOnly recipeOnly)+          reusedCount = recipeReused + length [() | (_, _, value) <- resolvedList, value ^. #source == FromApplication]           overriddenCount =-            length-              [ ()-              | (instanceId, name, value) <- resolvedList,-                value ^. #source == FromCLI,-                Map.member name (Map.findWithDefault Map.empty instanceId prior)-              ]+            recipeChanged+              + length+                [ ()+                | (instanceId, name, value) <- resolvedList,+                  value ^. #source == FromCLI,+                  Map.member name (Map.findWithDefault Map.empty instanceId prior)+                ]           newCount =-            length-              [ ()-              | (instanceId, name, _) <- resolvedList,-                Map.notMember name (Map.findWithDefault Map.empty instanceId prior)-              ]+            recipeNew+              + length+                [ ()+                | (instanceId, name, _) <- resolvedList,+                  Map.notMember name (Map.findWithDefault Map.empty instanceId prior)+                ]           removedCount =-            length-              [ ()-              | (instanceId, oldValues) <- Map.toList prior,-                name <- Map.keys oldValues,-                Map.notMember name (Map.findWithDefault Map.empty instanceId candidateValues)-              ]+            recipeRemoved+              + length+                [ ()+                | (instanceId, oldValues) <- Map.toList prior,+                  name <- Map.keys oldValues,+                  Map.notMember name (Map.findWithDefault Map.empty instanceId candidateValues)+                ]        in summary             & #reused             %~ (+ reusedCount)@@ -1220,6 +1261,7 @@       instances,       commandReceipts = receipts,       checkoutCommands = composition ^. #checkoutCommands,+      recipeInputs = composition ^. #recipeInputs,       appliedAt = composition ^. #appliedAt     } @@ -1534,3 +1576,13 @@ reconciliationUpdateError :: Manifest -> ReconciliationError -> UpdateError reconciliationUpdateError manifest (SeedReleaseBlockedByOwners path owners) = UpdateSeedReleaseBlocked path (Set.map (applicationRef manifest) owners) reconciliationUpdateError _ err = UpdateReconciliationFailed err++-- Preserve recipe edge requirements when replaying a composition during update.+loadCandidateComposition :: [FilePath] -> CandidateArtifact -> ModuleName -> [ModuleName] -> IO (Either ModuleLoadError [(ModuleInstance, Module, FilePath)])+loadCandidateComposition paths artifact primary additional = do+  checked <- case artifact ^. #recipeDefinition of+    Nothing -> pure (Right ())+    Just recipe -> verifyDependencySources paths (artifact ^. #sourceDirectory) (recipe ^. #modules)+  case checked of+    Left err -> pure (Left err)+    Right () -> loadComposition paths primary additional
src/Seihou/CLI/Update/Types.hs view
@@ -350,6 +350,7 @@         && previous ^. #additionalModules == candidate ^. #additionalModules         && previous ^. #namespace == candidate ^. #namespace         && previous ^. #context == candidate ^. #context+        && previous ^. #recipeInputs == candidate ^. #recipeInputs         && length (previous ^. #instances) == length (candidate ^. #instances)         && and (zipWith sameInstance (previous ^. #instances) (candidate ^. #instances))         && previous ^. #commandReceipts == (candidate ^. #commandReceipts)
+ src/Seihou/CLI/ValidateRecipeReport.hs view
@@ -0,0 +1,20 @@+module Seihou.CLI.ValidateRecipeReport (recipeLoadErrorText) where++import Data.Text (Text)+import Data.Text qualified as T+import Seihou.Core.Types (ModuleLoadError (..), ModuleName (..))++-- Keep the evaluator's useful parser/type diagnostic without exposing the+-- internal error constructor or mistaking the recipe for a module.+recipeLoadErrorText :: ModuleLoadError -> Text+recipeLoadErrorText (DhallEvalError _ reason) = "Cannot evaluate recipe.dhall: " <> reason+recipeLoadErrorText (DhallDecodeError _ reason) = "Cannot decode recipe.dhall: " <> reason+recipeLoadErrorText (ValidationError _ problems) = T.intercalate "; " problems+recipeLoadErrorText (ModuleNotFound (ModuleName name) searched) =+  "Module '" <> name <> "' not found; searched: " <> T.intercalate ", " (map T.pack searched)+recipeLoadErrorText (CircularDependency names) =+  "Circular dependency: " <> T.intercalate " -> " [name | ModuleName name <- names]+recipeLoadErrorText (MissingSourceFile (ModuleName name) path) =+  "Module '" <> name <> "' is missing source file " <> T.pack path+recipeLoadErrorText (RegistryEvalError source reason) =+  "Cannot evaluate registry '" <> source <> "': " <> reason
test/Main.hs view
@@ -22,6 +22,7 @@ import Seihou.CLI.ExtensionSpec qualified as ExtensionSpec import Seihou.CLI.GitSpec qualified as GitSpec import Seihou.CLI.InitSpec qualified as InitSpec+import Seihou.CLI.InstallClosureSpec qualified as InstallClosureSpec import Seihou.CLI.InstallCollisionSpec qualified as InstallCollisionSpec import Seihou.CLI.InstallHistorySpec qualified as InstallHistorySpec import Seihou.CLI.InstallSourceSpec qualified as InstallSourceSpec@@ -33,6 +34,7 @@ import Seihou.CLI.MigrateSpec qualified as MigrateSpec import Seihou.CLI.PendingMigrationSpec qualified as PendingMigrationSpec import Seihou.CLI.PromptRenderSpec qualified as PromptRenderSpec+import Seihou.CLI.RecipeInputsE2ESpec qualified as RecipeInputsE2E import Seihou.CLI.RecordedReleaseSpec qualified as RecordedReleaseSpec import Seihou.CLI.Registry.SyncSpec qualified as RegistrySyncSpec import Seihou.CLI.Registry.ValidateSpec qualified as RegistryValidateSpec@@ -50,6 +52,7 @@ import Seihou.CLI.UpdateSpec qualified as UpdateSpec import Seihou.CLI.UpgradeDiagnosisSpec qualified as UpgradeDiagnosisSpec import Seihou.CLI.UpgradeSpec qualified as UpgradeSpec+import Seihou.CLI.ValidateRecipeE2ESpec qualified as ValidateRecipeE2E import Seihou.FzfSpec qualified as FzfSpec import Test.Tasty @@ -76,6 +79,7 @@         ExtensionSpec.tests,         GitSpec.tests,         InitSpec.tests,+        InstallClosureSpec.tests,         InstallCollisionSpec.tests,         InstallHistorySpec.tests,         InstallSourceSpec.tests,@@ -108,5 +112,7 @@         FzfSpec.tests       ]   seedUpdateTests <- SeedUpdateE2E.tests+  validateRecipeTests <- ValidateRecipeE2E.tests+  recipeInputsTests <- RecipeInputsE2E.tests   seedRunTests <- SeedRunE2E.tests-  defaultMain (testGroup "seihou-cli" (seedUpdateTests : seedRunTests : tests))+  defaultMain (testGroup "seihou-cli" (validateRecipeTests : recipeInputsTests : seedUpdateTests : seedRunTests : tests))
test/Seihou/CLI/AgentCompletionSpec.hs view
@@ -25,6 +25,23 @@  tests :: IO TestTree tests = testSpec "Seihou.CLI.AgentCompletion" $ do+  describe "initial CLI instructions" $ do+    it "supplies a neutral CLI user turn and preserves explicit/API inputs" $ do+      let neutral = Just "Follow the instructions in the system prompt."+      mapM_+        ( \provider -> do+            resolveAgentInitialPrompt provider Nothing `shouldBe` neutral+            resolveAgentInitialPrompt provider (Just "  ") `shouldBe` neutral+            resolveAgentInitialPrompt provider (Just "  migrate carefully  ") `shouldBe` Just "  migrate carefully  "+        )+        [AgentProviderClaudeCli, AgentProviderCodexCli]+      mapM_+        ( \provider -> do+            resolveAgentInitialPrompt provider Nothing `shouldBe` Nothing+            resolveAgentInitialPrompt provider (Just "  ") `shouldBe` Just "  "+        )+        [AgentProviderAnthropic, AgentProviderOpenAI]+   describe "provider text helpers" $ do     it "parses known providers case-insensitively" $ do       providerFromText "claude-cli" `shouldBe` Right AgentProviderClaudeCli
test/Seihou/CLI/AgentMigrateE2ESpec.hs view
@@ -21,6 +21,7 @@     createDirectoryIfMissing,     doesFileExist,     executable,+    findExecutable,     getPermissions,     listDirectory,     removeDirectoryRecursive,@@ -37,6 +38,8 @@  tests :: IO TestTree tests = testSpec "Agent migrate end-to-end" $ do+  mapM_ batchMigrationProof ["claude-cli", "codex-cli"]+   it "exposes non-interactive blueprint runs in help" $ do     binary <- seihouBinary     (exitCode, output, _) <- runProcessText binary ["agent", "run", "--help"] Nothing Nothing@@ -61,7 +64,7 @@         "{\"name\":\"seihou-test-skill\",\"kind\":\"skill\",\"hash\":\"test\",\"installedAt\":\"2026-10-15T00:00:00Z\",\"visibility\":\"tool-only\"}"       TIO.writeFile         fakeCodex-        "#!/bin/sh\nif [ \"$1\" = \"--version\" ]; then printf 'codex-cli 1.0.0\\n'; exit 0; fi\nprintf '%s\\n' \"$@\" > \"$SEIHOU_FAKE_AGENT_LOG\"\nprintf '%s\\n' '{\"type\":\"item.completed\",\"item\":{\"type\":\"agent_message\",\"text\":\"kit session complete\"}}'\n"+        "#!/bin/sh\nif [ \"$1\" = \"--version\" ]; then printf 'codex-cli 1.0.0\\n'; exit 0; fi\nprintf '%s\\n' \"$@\" > \"$SEIHOU_FAKE_AGENT_LOG\"\nprintf '%s\\n' '{\"type\":\"item.completed\",\"item\":{\"type\":\"agent_message\",\"text\":\"kit session complete\"}}'\nprintf '%s\\n' '{\"type\":\"turn.completed\",\"usage\":{}}'\n"       permissions <- getPermissions fakeCodex       -- Permissions comes from directory and has no Generic instance.       setPermissions fakeCodex (permissions {executable = True})@@ -263,7 +266,7 @@       createDirectoryIfMissing True xdgHome       createDirectoryIfMissing True fakeBin       TIO.writeFile blueprintPath migrationBlueprintDhall-      TIO.writeFile fakeClaude "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nexit 0\n"+      TIO.writeFile fakeClaude "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nprintf '%s\\n' '{\"type\":\"result\",\"subtype\":\"success\",\"result\":\"migration complete\",\"is_error\":false,\"permission_denials\":[]}'\nexit 0\n"       permissions <- getPermissions fakeClaude       -- Permissions comes from `directory` and has no Generic instance, so it       -- has no #executable label. Record update syntax is the only option.@@ -335,7 +338,7 @@       -- edge applies for real when it is replanned.       TIO.writeFile         fakeClaude-        "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nif [ \"$(wc -l < \"$SEIHOU_FAKE_AGENT_LOG\" | tr -d ' ')\" = \"1\" ]; then\n  printf '%s\\n' \"$SEIHOU_FAKE_SIGNAL_REASON\" > \"$SEIHOU_FAKE_SIGNAL_FILE\"\nfi\nexit 0\n"+        "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nif [ \"$(wc -l < \"$SEIHOU_FAKE_AGENT_LOG\" | tr -d ' ')\" = \"1\" ]; then\n  printf '%s\\n' \"$SEIHOU_FAKE_SIGNAL_REASON\" > \"$SEIHOU_FAKE_SIGNAL_FILE\"\nfi\nprintf '%s\\n' '{\"type\":\"result\",\"subtype\":\"success\",\"result\":\"migration complete\",\"is_error\":false,\"permission_denials\":[]}'\nexit 0\n"       permissions <- getPermissions fakeClaude       -- Permissions comes from `directory` and has no Generic instance, so it       -- has no #executable label. Record update syntax is the only option.@@ -409,6 +412,57 @@       settledOutput `shouldSatisfy` T.isInfixOf "already have receipts"       T.lines <$> TIO.readFile launchLog `shouldReturn` ["called", "called", "called"] +  it "keeps the first receipt, stops on a failed owner, and resumes only pending work" $+    withCohortProject $ \root run -> do+      let args = ["agent", "migrate", "keiro-upgrade", "--from", "2.4.0", "--to", "3.0.0", "Keep my explicit instruction", "--model", "migration-model", "--effort", "high", "--trace", "file"]+          script = root </> "bin/claude"+          logPath = root </> "agent-launch.log"+          manifestPath = root </> ".seihou/manifest.json"+          success = "{\"type\":\"result\",\"subtype\":\"success\",\"is_error\":false,\"permission_denials\":[],\"result\":\"done\"}"+      TIO.writeFile+        (root </> ".seihou/modules/kiroku-upgrade/blueprint.dhall")+        (T.replace "allowedTools = None (List Text)" "allowedTools = Some [ \"Bash(kiroku *)\" ]" (kirokuBlueprintDhall "1.9.0"))+      TIO.writeFile+        (root </> ".seihou/modules/keiro-upgrade/blueprint.dhall")+        (T.replace "allowedTools = None (List Text)" "allowedTools = Some [ \"Bash(keiro *)\" ]" keiroBlueprintDhall)+      TIO.writeFile script $+        T.unlines+          [ "#!/bin/sh",+            "printf '%s\\0' \"$*\" >> \"$SEIHOU_FAKE_AGENT_LOG\"",+            "if [ -f first-done ] && [ ! -f retry-ready ]; then printf reason > .seihou/.migrate-signal; echo provider-failure >&2; exit 9; fi",+            "touch first-done",+            "cat <<'RESULT'",+            success,+            "RESULT"+          ]+      (failed, _, failure) <- run args+      failed `shouldSatisfy` (/= ExitSuccess)+      failure `shouldSatisfy` T.isInfixOf "provider-failure"+      receipts <- readReceipts manifestPath+      receipts `shouldBe` [("1.9.0", "2.0.0", MigrationApplied)]+      doesFileExist (root </> ".seihou/.migrate-signal") `shouldReturn` False+      launches <- filter (not . T.null) . T.splitOn "\0" <$> TIO.readFile logPath+      length launches `shouldBe` 2+      T.concat (take 1 launches) `shouldSatisfy` T.isInfixOf (T.pack (root </> ".seihou/modules/kiroku-upgrade/files"))+      T.concat (take 1 launches) `shouldNotSatisfy` T.isInfixOf (T.pack (root </> ".seihou/modules/keiro-upgrade/files"))+      last launches `shouldSatisfy` T.isInfixOf (T.pack (root </> ".seihou/modules/keiro-upgrade/files"))+      last launches `shouldSatisfy` T.isInfixOf "Keep my explicit instruction"+      T.concat (take 1 launches) `shouldSatisfy` T.isInfixOf "Bash(kiroku *)"+      last launches `shouldSatisfy` T.isInfixOf "Bash(keiro *)"+      last launches `shouldSatisfy` T.isInfixOf "--model migration-model"+      last launches `shouldSatisfy` T.isInfixOf "--effort high"+      TIO.writeFile (root </> "retry-ready") ""+      (resumed, output, errors) <- run args+      expectSuccess "resume after failed second owner" resumed output errors+      completed <- readReceipts manifestPath+      length completed `shouldBe` 2+      allLaunches <- filter (not . T.null) . T.splitOn "\0" <$> TIO.readFile logPath+      length allLaunches `shouldBe` 3+      last allLaunches `shouldNotSatisfy` T.isInfixOf (T.pack (root </> ".seihou/modules/kiroku-upgrade/files"))++      traces <- T.lines <$> TIO.readFile (root </> ".seihou/trace.jsonl")+      length traces `shouldBe` 6+   -- The cohort story end to end. A keiro edge entails a kiroku edge; one   -- command plans both, in order, each carrying its own blueprint's reference   -- files. --debug is the ideal surface: it exercises discovery, expansion, and@@ -782,7 +836,7 @@     -- The fake logs every invocation so a test can prove a session did NOT     -- start. An assertion that the log is absent is only evidence when the     -- fake would have written it; a silently succeeding fake proves nothing.-    TIO.writeFile fakeClaude "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nexit 0\n"+    TIO.writeFile fakeClaude "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nprintf '%s\\n' '{\"type\":\"result\",\"subtype\":\"success\",\"result\":\"migration complete\",\"is_error\":false,\"permission_denials\":[]}'\nexit 0\n"     permissions <- getPermissions fakeClaude     -- Permissions comes from `directory` and has no Generic instance, so it     -- has no #executable label. Record update syntax is the only option.@@ -861,7 +915,7 @@     -- The fake logs every invocation so a test can prove a session did NOT     -- start. An assertion that the log is absent is only evidence when the     -- fake would have written it; a silently succeeding fake proves nothing.-    TIO.writeFile fakeClaude "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nexit 0\n"+    TIO.writeFile fakeClaude "#!/bin/sh\nprintf 'called\\n' >> \"$SEIHOU_FAKE_AGENT_LOG\"\nprintf '%s\\n' '{\"type\":\"result\",\"subtype\":\"success\",\"result\":\"migration complete\",\"is_error\":false,\"permission_denials\":[]}'\nexit 0\n"     permissions <- getPermissions fakeClaude     -- Permissions comes from `directory` and has no Generic instance, so it     -- has no #executable label. Record update syntax is the only option.@@ -966,8 +1020,30 @@   Maybe [(String, String)] ->   IO (ExitCode, T.Text, T.Text) runProcessText binary args workingDirectory environment = do-  let command = (proc binary args) {cwd = workingDirectory, env = environment}-  (exitCode, stdoutText, stderrText) <- readCreateProcessWithExitCode command ""+  -- Own the process group and bound each real-binary fixture, including its+  -- descendants, so an accidental interactive launch cannot stall the suite.+  python <- findExecutable "python3" >>= maybe (fail "python3 is required for process fixture ownership") pure+  let bounded =+        unlines+          [ "import subprocess,sys,os,signal",+            "p=subprocess.Popen(sys.argv[1:],stdin=subprocess.DEVNULL,stdout=subprocess.PIPE,stderr=subprocess.PIPE,start_new_session=True)",+            "try:",+            " o,e=p.communicate(timeout=45)",+            "except subprocess.TimeoutExpired:",+            " pairs=[tuple(map(int,line.split())) for line in subprocess.check_output(['ps','-axo','pid=,ppid='],text=True).splitlines()]",+            " owned={p.pid}",+            " while True:",+            "  expanded=owned|{pid for pid,parent in pairs if parent in owned}",+            "  if expanded==owned: break",+            "  owned=expanded",+            " for pid in reversed(sorted(owned)):",+            "  try: os.kill(pid,signal.SIGKILL)",+            "  except ProcessLookupError: pass",+            " o,e=p.communicate(); sys.stderr.write('migration fixture timed out\\n'); p.returncode=124",+            "sys.stdout.buffer.write(o); sys.stderr.buffer.write(e); sys.exit(p.returncode)"+          ]+      wrapped = (proc python (["-c", bounded, binary] <> args)) {cwd = workingDirectory, env = environment}+  (exitCode, stdoutText, stderrText) <- readCreateProcessWithExitCode wrapped ""   pure (exitCode, T.pack stdoutText, T.pack stderrText)  -- | Fail with the captured streams when a run that was expected to succeed@@ -1119,3 +1195,129 @@       ", migrations = [] : List { from : Text, to : Text, prompt : Text }",       "}"     ]++-- Minimal envelopes captured from Claude Code 2.1.312 and Codex 0.164.0.+-- The executable must select the editing transport without a positional prompt.+batchMigrationProof :: String -> Spec+batchMigrationProof provider = it ("migrates through pipes with " <> provider <> " and preserves terminal mode") $+  withSystemTempDirectory "seihou-migration-mode" $ \root -> do+    binary <- seihouBinary+    inherited <- getEnvironment+    let blueprintDir = root </> ".seihou/modules/payments"+        binDir = root </> "bin"+        logPath = root </> "args"+        workspace = root </> "edited"+        isClaude = provider == "claude-cli"+        executableName = if isClaude then "claude" else "codex"+        script = binDir </> executableName+        reply =+          if isClaude+            then "{\"type\":\"result\",\"future_field\":true,\"subtype\":\"success\",\"is_error\":false,\"permission_denials\":[],\"result\":\"edited\"}"+            else "{\"type\":\"item.completed\",\"item\":{\"type\":\"agent_message\",\"text\":\"edited\"}}\n{\"type\":\"turn.completed\",\"usage\":{}}"+        command = ["agent", "migrate", "payments", "--from", "1.0.0", "--to", "2.0.0", "--var", "library.name=baikai"]+        environment =+          [("PATH", binDir <> [searchPathSeparator] <> fromMaybe "" (lookup "PATH" inherited)), ("XDG_CONFIG_HOME", root </> "xdg"), ("SEIHOU_AGENT_PROVIDER", provider), ("SEIHOU_FAKE_AGENT_LOG", logPath)]+            <> filter (\(key, _) -> key /= "PATH" && key /= "XDG_CONFIG_HOME" && key /= "SEIHOU_CONTEXT" && not ("SEIHOU_AGENT_" `T.isPrefixOf` T.pack key)) inherited+        run args = runProcessText binary args (Just root) (Just environment)+    mapM_ (createDirectoryIfMissing True) [blueprintDir, binDir, root </> "xdg"]+    TIO.writeFile (blueprintDir </> "blueprint.dhall") migrationBlueprintDhall+    TIO.writeFile script $+      T.unlines+        [ "#!/bin/sh",+          "if [ ! -t 0 ]; then case \"$1\" in -p|exec) ;; *) echo interactive-argv-through-pipes >&2; exit 91;; esac; fi",+          "printf '%s\\n' \"$@\" > \"$SEIHOU_FAKE_AGENT_LOG\"",+          "printf edited > edited",+          "cat <<'RESULT'",+          T.pack reply,+          "RESULT"+        ]+    permissions <- getPermissions script+    setPermissions script (permissions {executable = True})+    -- Every adversarial attempt writes an outcome signal too: validation must+    -- reject it before either outcome channel can create a receipt.+    let good = T.pack reply+        badReplies =+          if isClaude+            then+              [ "not-json",+                "{}",+                "",+                T.replace "false" "true" good,+                T.replace "\"permission_denials\":[]" "\"permission_denials\":[{\"tool_name\":\"Write\"}]" good,+                "[" <> good <> ",{\"type\":\"error\",\"message\":\"failed\"}]",+                good <> "garbage"+              ]+            else+              [ "not-json",+                "{}",+                "",+                good <> "\n{\"type\":\"error\",\"message\":\"failed\"}",+                T.takeWhile (/= '\n') good,+                good <> "\ncorrupt",+                good <> "\n{\"type\":\"permission_denied\"}"+              ]+        writeReply body exitStatus =+          TIO.writeFile script $+            T.unlines+              ["#!/bin/sh", "printf reason > .seihou/.migrate-signal", "cat <<'RESULT'", body, "RESULT", "exit " <> exitStatus]+        checkFailure body status = do+          writeReply body status+          (failed, _, failure) <- run command+          failed `shouldSatisfy` (/= ExitSuccess)+          failure `shouldSatisfy` T.isInfixOf "retry"+          doesFileExist (root </> ".seihou/manifest.json") `shouldReturn` False+          doesFileExist (root </> ".seihou/.migrate-signal") `shouldReturn` False+    mapM_ (\body -> checkFailure body "0") badReplies+    checkFailure good "7"+    -- A missing executable/interpreter is an actionable startup failure.+    TIO.writeFile script ("#!" <> T.pack (root </> "missing-interpreter") <> "\n")+    (missing, _, missingError) <- runProcessText binary command (Just root) (Just (("PATH", binDir) : filter ((/= "PATH") . fst) environment))+    missing `shouldSatisfy` (/= ExitSuccess)+    missingError `shouldSatisfy` T.isInfixOf "Could not start"+    doesFileExist (root </> ".seihou/manifest.json") `shouldReturn` False+    TIO.writeFile (root </> ".seihou/.migrate-signal") "stale reason"+    -- Restore the editing executable for the ordinary-path proof.+    TIO.writeFile script $+      T.unlines+        [ "#!/bin/sh",+          "if [ ! -t 0 ]; then case \"$1\" in -p|exec) ;; *) echo interactive-argv-through-pipes >&2; exit 91;; esac; fi",+          "printf '%s\\n' \"$@\" > \"$SEIHOU_FAKE_AGENT_LOG\"",+          "printf edited > edited",+          "cat <<'RESULT'",+          good,+          "RESULT"+        ]+    (code, out, err) <- run command+    expectSuccess "automatic migration" code out err+    out `shouldSatisfy` T.isInfixOf "(batch)"+    TIO.readFile workspace `shouldReturn` "edited"+    argv <- T.lines <$> TIO.readFile logPath+    argv `shouldSatisfy` elem (if isClaude then "-p" else "exec")+    argv `shouldSatisfy` any (T.isInfixOf "Follow the instructions in the system prompt.")+    receipts <- readReceipts (root </> ".seihou/manifest.json")+    length receipts `shouldBe` 1+    (again, output, errors) <- run command+    expectSuccess "repeat migration" again output errors+    output `shouldSatisfy` T.isInfixOf "already have receipts"+    -- A real terminal on stdin selects interactive argv; --batch overrides it.+    let ptyCode = "import os,pty,subprocess,sys; m,s=pty.openpty(); p=subprocess.run(sys.argv[1:],stdin=s); os.close(s); os.close(m); sys.exit(p.returncode)"+        runPty flags = runProcessText "python3" (["-c", ptyCode, binary] <> command <> ["--rerun"] <> flags) (Just root) (Just environment)+    (interactive, io, ie) <- runPty []+    expectSuccess "terminal migration" interactive io ie+    interactiveArgs <- T.lines <$> TIO.readFile logPath+    interactiveArgs `shouldSatisfy` notElem (if isClaude then "-p" else "exec")+    (explicit, bo, be) <- runPty ["--batch"]+    expectSuccess "explicit terminal batch" explicit bo be+    batchArgs <- T.lines <$> TIO.readFile logPath+    batchArgs `shouldSatisfy` elem (if isClaude then "-p" else "exec")+    -- A valid completion can report inapplicability by text or file; the+    -- file takes precedence. These outcomes remain eligible on a later run.+    writeReply (T.replace "edited" "SEIHOU: not-applicable text-marker" good) "0"+    (skipped, so, se) <- run (command <> ["--rerun"])+    expectSuccess "not-applicable file over marker" skipped so se+    outcomes <- readReceipts (root </> ".seihou/manifest.json")+    outcomes `shouldBe` [("1.0.0", "2.0.0", MigrationNotApplicable "reason")]+    TIO.writeFile script $ T.unlines ["#!/bin/sh", "cat <<'RESULT'", T.replace "edited" "SEIHOU: not-applicable text-marker" good, "RESULT"]+    (marker, mo, me) <- run command+    expectSuccess "text-marker retry" marker mo me+    readReceipts (root </> ".seihou/manifest.json") `shouldReturn` [("1.0.0", "2.0.0", MigrationNotApplicable "text-marker")]
+ test/Seihou/CLI/InstallClosureSpec.hs view
@@ -0,0 +1,57 @@+module Seihou.CLI.InstallClosureSpec (tests) where++import Data.Either (isLeft)+import Seihou.CLI.InstallClosure (installClosureInto)+import Seihou.CLI.InstallShared (installModuleDirInto)+import System.Directory+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.CLI.InstallClosure" $ do+  it "refuses an escaping selected path without creating a cache" $+    withSystemTempDirectory "closure" $ \tmp -> do+      let repo = tmp </> "repo"+          cache = tmp </> "cache"+      createDirectory repo+      result <- installClosureInto cache False repo "https://example.com/registry" [("escape", tmp)]+      result `shouldSatisfy` isLeft+      doesDirectoryExist cache `shouldReturn` False++  it "preflights all roots before replacing any existing artifact" $+    withSystemTempDirectory "closure" $ \tmp -> do+      let repo = tmp </> "repo"+          cache = tmp </> "cache"+      moduleDir repo "good"+      _ <- installModuleDirInto cache False (repo </> "good") "good" "https://example.com/registry" Nothing Nothing []+      writeFile (cache </> "good" </> "marker") "original"+      createDirectory (repo </> "bad")+      writeFile (repo </> "bad" </> "recipe.dhall") "this is not Dhall"+      result <- installClosureInto cache False repo "https://example.com/registry" [("good", repo </> "good"), ("bad", repo </> "bad")]+      result `shouldSatisfy` isLeft+      readFile (cache </> "good" </> "marker") `shouldReturn` "original"+      doesDirectoryExist (cache </> "bad") `shouldReturn` False++  it "restores an earlier replacement when a later destination cannot be written" $+    withSystemTempDirectory "closure" $ \tmp -> do+      let repo = tmp </> "repo"+          cache = tmp </> "cache"+      moduleDir repo "good"+      moduleDir repo "blocked"+      _ <- installModuleDirInto cache False (repo </> "good") "good" "https://example.com/registry" Nothing Nothing []+      writeFile (cache </> "good" </> "marker") "original"+      writeFile (cache </> "blocked") "occupied file"+      result <- installClosureInto cache False repo "https://example.com/registry" [("good", repo </> "good"), ("blocked", repo </> "blocked")]+      result `shouldSatisfy` isLeft+      readFile (cache </> "good" </> "marker") `shouldReturn` "original"+      readFile (cache </> "blocked") `shouldReturn` "occupied file"++moduleDir :: FilePath -> String -> IO ()+moduleDir root name = do+  schema <- canonicalizePath "../schema/Module.dhall"+  let dir = root </> name+  createDirectoryIfMissing True dir+  writeFile (dir </> "module.dhall") ("let Module = " <> schema <> " in Module::{ name = \"" <> name <> "\", version = Some \"1.0.0\" }")
test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs view
@@ -53,6 +53,7 @@       instances = [],       commandReceipts = Map.empty,       checkoutCommands = [],+      recipeInputs = Nothing,       appliedAt = testTime     } @@ -292,7 +293,7 @@         case manifestFromJSON written of           Left err -> expectationFailure err           Right upgraded -> do-            (upgraded ^. #version) `shouldBe` ManifestSchemaVersion 11+            (upgraded ^. #version) `shouldBe` ManifestSchemaVersion 12             (^. #sharedWriteMode) <$> Map.lookup ".gitignore" (upgraded ^. #files)               `shouldBe` Just SharedWriteAdditiveOnly         TIO.readFile (fixture ^. #gitignorePath) `shouldReturn` gitignoreBefore
test/Seihou/CLI/ManifestRepairOriginsSpec.hs view
@@ -59,6 +59,7 @@           instances = [AppliedInstanceState "beta" emptyParentVars (origin localPath "beta") (Just "1.0.0") Map.empty],           commandReceipts = Map.empty,           checkoutCommands = [],+          recipeInputs = Nothing,           appliedAt = testTime         }     receipt =
test/Seihou/CLI/ManifestUpgradeSpec.hs view
@@ -264,12 +264,12 @@         outcome <- runManifestUpgrade (opts False False Nothing)         case outcome of           UpgradeWritten result -> do-            map stepVersions (result ^. #steps) `shouldBe` [(6, 7), (7, 8), (8, 9), (9, 10), (10, 11)]+            map stepVersions (result ^. #steps) `shouldBe` [(6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12)]             (result ^. #entries) `shouldBe` []-            (result ^. #toVersion) `shouldBe` ManifestSchemaVersion 11+            (result ^. #toVersion) `shouldBe` ManifestSchemaVersion 12           other -> expectationFailure ("expected a write, got " <> show other)         document <- readDocument manifestPath-        lookupPath ["version"] document `shouldBe` Just (Aeson.Number 11)+        lookupPath ["version"] document `shouldBe` Just (Aeson.Number 12)         lookupPath ["files", ".gitignore", "sharedWriteMode"] document `shouldBe` Just (Aeson.String "additive-only")         lookupPath ["files", "README.md", "sharedWriteMode"] document `shouldBe` Just (Aeson.String "unknown")         lookupPath ["files", ".gitignore", "additiveOnly"] document `shouldBe` Nothing@@ -281,7 +281,7 @@         before <- LBS.readFile manifestPath         outcome <- runManifestUpgrade (opts False False Nothing)         case outcome of-          UpgradeNotNeeded version _ -> version `shouldBe` ManifestSchemaVersion 11+          UpgradeNotNeeded version _ -> version `shouldBe` ManifestSchemaVersion 12           other -> expectationFailure ("expected nothing to do, got " <> show other)         LBS.readFile manifestPath `shouldReturn` before @@ -310,7 +310,7 @@         outcome <- runManifestUpgrade (opts True True Nothing)         case outcome of           UpgradeWouldWrite result [] -> do-            map stepVersions (result ^. #steps) `shouldBe` [(5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11)]+            map stepVersions (result ^. #steps) `shouldBe` [(5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12)]             map (^. #artifactName) (result ^. #entries)               `shouldBe` ["haskell-base", "project-lint", "haskell-service", "scratch-helper"]             let report = formatUpgradeReport result@@ -335,10 +335,10 @@         outcome <- runManifestUpgrade (opts False True Nothing)         case outcome of           UpgradeWritten result ->-            map stepVersions (result ^. #steps) `shouldBe` [(2, 3), (3, 4), (4, 5), (5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11)]+            map stepVersions (result ^. #steps) `shouldBe` [(2, 3), (3, 4), (4, 5), (5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12)]           other -> expectationFailure ("expected a write, got " <> show other)         document <- readDocument manifestPath-        lookupPath ["version"] document `shouldBe` Just (Aeson.Number 11)+        lookupPath ["version"] document `shouldBe` Just (Aeson.Number 12)      it "rejects a target newer than this build or older than the document" $ do       withUpgradeProject schema6Manifest $ \_ ->@@ -366,7 +366,7 @@         output `shouldSatisfy` T.isInfixOf "5 -> 6"         output `shouldSatisfy` T.isInfixOf "6 -> 7"         document <- readDocument manifestPath-        lookupPath ["version"] document `shouldBe` Just (Aeson.Number 11)+        lookupPath ["version"] document `shouldBe` Just (Aeson.Number 12)         lookupPath ["modules", "0", "origin"] document           `shouldBe` Just (Aeson.toJSON (RemoteOrigin "https://example.com/demo-modules.git" "demo" (Just "demo-modules")))         filter absoluteLooking (documentStrings document) `shouldBe` []
+ test/Seihou/CLI/RecipeInputsE2ESpec.hs view
@@ -0,0 +1,81 @@+module Seihou.CLI.RecipeInputsE2ESpec (tests) where++import Control.Monad (forM_)+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LBS+import Data.Generics.Labels ()+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.SeedRunE2ESpec (invoke, prepare, readManifest, success)+import Seihou.Core.Types+import Seihou.Prelude+import System.Directory qualified as D+import System.Exit (ExitCode (..))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++prepareRecipe root = do+  (binary, modul) <- prepare root+  let other = root </> ".seihou/modules/other"+      recipe = root </> ".seihou/modules/recipe-input-probe"+      body name = "let S = ../demo/schema/package.dhall in S.Module::{name=\"" <> name <> "\",version=Some \"1.0.0\",vars=[S.VarDecl::{name=\"feature\",type=\"bool\",default=Some \"false\"}],steps=[S.Step::{strategy=\"template\",src=\"value\",dest=\"" <> name <> ".txt\"}]}"+  D.createDirectoryIfMissing True (other </> "files")+  D.createDirectoryIfMissing True recipe+  TIO.writeFile (modul </> "module.dhall") (body "demo")+  TIO.writeFile (other </> "module.dhall") (body "other")+  TIO.writeFile (modul </> "files/value") "{{feature}}"+  TIO.writeFile (other </> "files/value") "{{feature}}"+  TIO.writeFile (recipe </> "recipe.dhall") "let S = ../demo/schema/package.dhall in S.Recipe::{name=\"recipe-input-probe\",version=Some \"1.0.0\",modules=[S.Dependency::{module=\"demo\"},S.Dependency::{module=\"other\"}],vars=[S.VarDecl::{name=\"feature\",type=\"bool\",required=True}],prompts=[S.Prompt::{var=\"feature\",text=\"Enable feature?\"}]}"+  pure binary++tests :: IO TestTree+tests = testSpec "Recipe inputs" $ do+  it "refuses missing recipe decisions before writing files or manifest" $+    withSystemTempDirectory "recipe-missing" $ \root -> do+      binary <- prepareRecipe root+      (code, out, err) <- invoke binary root ["run", "recipe-input-probe"]+      code `shouldBe` ExitFailure 1+      T.pack (out <> err) `shouldSatisfy` T.isInfixOf "feature"+      D.doesPathExist (root </> "demo.txt") `shouldReturn` False+      D.doesPathExist (root </> ".seihou/manifest.json") `shouldReturn` False+  forM_ ["true", "false"] $ \choice ->+    it ("broadcasts and records " <> T.unpack choice) $+      withSystemTempDirectory "recipe-choice" $ \root -> do+        binary <- prepareRecipe root+        _ <- success binary root ["run", "recipe-input-probe", "--var", "feature=" <> T.unpack choice]+        TIO.readFile (root </> "demo.txt") `shouldReturn` choice+        TIO.readFile (root </> "other.txt") `shouldReturn` choice+        manifest <- readManifest root+        map (^. #recipeInputs) (manifest ^. #applications) `shouldBe` [Just (Map.singleton "feature" choice)]++  it "adopts an older application through ordinary preview and atomic apply" $+    withSystemTempDirectory "recipe-adoption" $ \root -> do+      binary <- prepareRecipe root+      _ <- success binary root ["run", "recipe-input-probe", "--var", "feature=false"]+      accepted <- readManifest root+      -- Construct a supported historical input, as emitted before schema 12.+      let older = accepted & #version .~ ManifestSchemaVersion 11 & #applications %~ map (\app -> app & #recipeInputs .~ Nothing)+          path = root </> ".seihou/manifest.json"+      LBS.writeFile path (Aeson.encode older)+      before <- LBS.readFile path+      _ <- success binary root ["update", "recipe-input-probe", "--dry-run", "--json"]+      LBS.readFile path `shouldReturn` before+      _ <- success binary root ["update", "recipe-input-probe", "--json"]+      adopted <- readManifest root+      map (^. #recipeInputs) (adopted ^. #applications) `shouldBe` [Just (Map.singleton "feature" "false")]+      unchanged <- success binary root ["update", "recipe-input-probe", "--json"]+      unchanged `shouldSatisfy` T.isInfixOf "\"alreadyUpToDate\":true"+  it "replays a recipe-only input after declining config saving" $+    withSystemTempDirectory "recipe-only" $ \root -> do+      binary <- prepareRecipe root+      let recipe = root </> ".seihou/modules/recipe-input-probe/recipe.dhall"+      definition <- TIO.readFile recipe+      TIO.writeFile recipe (T.replace "vars=[S.VarDecl" "vars=[S.VarDecl::{name=\"recipe.only\",type=\"bool\",required=True},S.VarDecl" definition)+      _ <- success binary root ["run", "recipe-input-probe", "--var", "feature=false", "--var", "recipe.only=true", "--no-save-prompted"]+      output <- success binary root ["update", "recipe-input-probe", "--dry-run", "--json"]+      output `shouldSatisfy` T.isInfixOf "\"alreadyUpToDate\":true"+      manifest <- readManifest root+      map (^. #recipeInputs) (manifest ^. #applications) `shouldBe` [Just (Map.fromList [("feature", "false"), ("recipe.only", "true")])]
test/Seihou/CLI/SavePromptedSpec.hs view
@@ -5,7 +5,7 @@ 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.CLI.SavePrompted (collectPromptedValues, collectRecipePromptedValues, offerSavePrompted) import Seihou.Composition.Instance (primaryInstance) import Seihou.Core.Types import Seihou.Effect.ConfigWriterPure (ConfigWriterState (..), emptyConfigWriterState, runConfigWriterPure)@@ -39,6 +39,14 @@  spec :: Spec spec = do+  it "saves recipe-only prompted false once and omits unchanged local values" $ do+    let decl = mkDecl "feature"+        value = ResolvedVar (VBool False) FromPrompt decl+        recipe = Map.singleton "feature" value+        modules = Map.singleton (primaryInstance "demo") recipe+    collectRecipePromptedValues recipe modules Map.empty `shouldBe` [("feature", "false", Nothing)]+    collectRecipePromptedValues recipe Map.empty (Map.singleton "feature" "false") `shouldBe` []+   describe "collectPromptedValues" $ do     it "extracts variables with FromPrompt source" $ do       let decl = mkDecl "project.name"
test/Seihou/CLI/StatusSpec.hs view
@@ -90,6 +90,7 @@       instances = map mkInstance modules,       commandReceipts = Map.empty,       checkoutCommands = [],+      recipeInputs = Nothing,       appliedAt = fixedTime     }   where
test/Seihou/CLI/UpdateE2ESpec.hs view
@@ -211,7 +211,7 @@       expectSuccess "targeted update" exitCode stdoutText stderrText       stdoutText `shouldSatisfy` T.isInfixOf "\"outcome\":\"applied\""       manifestText <- TIO.readFile (fixture ^. #manifestPath)-      manifestText `shouldSatisfy` T.isInfixOf "\"version\":11"+      manifestText `shouldSatisfy` T.isInfixOf "\"version\":12"       manifestText `shouldSatisfy` T.isInfixOf "\"sharedWriteMode\":\"additive-only\""       -- Recording an answer must not touch a single byte of the project.       TIO.readFile (fixture ^. #gitignorePath) `shouldReturn` beforeGitignore@@ -271,7 +271,7 @@       case decoded of         Left err -> expectationFailure err         Right manifest -> do-          (manifest ^. #version) `shouldBe` ManifestSchemaVersion 11+          (manifest ^. #version) `shouldBe` ManifestSchemaVersion 12           case Map.lookup ".gitignore" (manifest ^. #files) of             Nothing -> expectationFailure "the manifest lost .gitignore"             Just record -> do
test/Seihou/CLI/UpdateSpec.hs view
@@ -583,7 +583,7 @@       withSystemTempDirectory "seihou-update-schema-5" $ \root -> do         fixture <- prepareSharedPathFixture CoOwnerAppends root         manifestText <- TIO.readFile (fixture ^. #manifestPath)-        TIO.writeFile (fixture ^. #manifestPath) (T.replace "\"version\":11" "\"version\":5" manifestText)+        TIO.writeFile (fixture ^. #manifestPath) (T.replace "\"version\":12" "\"version\":5" manifestText)         withSavedEnv "XDG_CONFIG_HOME" (Just (fixture ^. #xdgHome)) $           withCurrentDirectory (fixture ^. #projectRoot) $ do             forM_ [NamedUpdateTargets ["alpha"], AllRecordedApplications] $ \selection -> do@@ -1038,6 +1038,7 @@               ],             commandReceipts = Map.empty,             checkoutCommands = [],+            recipeInputs = Nothing,             appliedAt = testTime           }       base = emptyManifest testTime@@ -1141,6 +1142,7 @@       instances,       commandReceipts = Map.empty,       checkoutCommands = [],+      recipeInputs = Nothing,       appliedAt = testTime     }   where
test/Seihou/CLI/UpgradeDiagnosisSpec.hs view
@@ -43,7 +43,7 @@       withFixture CoOwnerAppendsPredatingEvidence noDamage $ \_ _ diagnose -> do         checks <- readiness <$> diagnose "alpha"         statusOf "manifest-schema-current" checks `shouldBe` NeedsAttention-        detailOf "manifest-schema-current" checks `shouldSatisfy` T.isInfixOf "schema 6 is older than 11"+        detailOf "manifest-schema-current" checks `shouldSatisfy` T.isInfixOf "schema 6 is older than 12"         statusOf "shared-evidence-known" checks `shouldBe` NeedsAttention         detailOf "shared-evidence-known" checks `shouldBe` ".gitignore is shared with beta and its write mode is unknown"         statusOf "update-plans-cleanly" checks `shouldBe` Ready@@ -59,7 +59,7 @@         ((^. #errorCode) <$> diagnosis ^. #updateDryRun) `shouldBe` ProbeOk (Just "shared_write_evidence_unavailable")      it "reports a schema-5 manifest as needing seihou manifest upgrade" $-      withFixture CoOwnerAppends (withManifestText (T.replace "\"version\":11" "\"version\":5")) $ \_ _ diagnose -> do+      withFixture CoOwnerAppends (withManifestText (T.replace "\"version\":12" "\"version\":5")) $ \_ _ diagnose -> do         diagnosis <- diagnose "alpha"         let checks = readiness diagnosis         statusOf "manifest-readable" checks `shouldBe` NeedsAttention@@ -154,7 +154,7 @@       [ ("healthy" :: Text, CoOwnerAppends, const (pure ())),         ("schema 6", CoOwnerAppendsPredatingEvidence, const (pure ())),         ("evidence unavailable", CoOwnerAppendsPredatingEvidence, evidenceUnavailable),-        ("schema 5", CoOwnerAppends, withManifestText (T.replace "\"version\":11" "\"version\":5")),+        ("schema 5", CoOwnerAppends, withManifestText (T.replace "\"version\":12" "\"version\":5")),         ("not json", CoOwnerAppends, withManifestText (const "{not json")),         ("local origin", CoOwnerAppends, localBetaOrigin),         ("pending transaction", CoOwnerAppends, pendingTransaction)
+ test/Seihou/CLI/ValidateRecipeE2ESpec.hs view
@@ -0,0 +1,148 @@+module Seihou.CLI.ValidateRecipeE2ESpec (tests) where++import Control.Monad (forM, forM_)+import Data.ByteString qualified as BS+import Data.List (sort)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.CLI.SeedRunE2ESpec (prepare)+import Seihou.CLI.SeihouBinary (seihouBinary)+import System.Directory qualified as D+import System.Environment (getEnvironment)+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode)+import System.Timeout (timeout)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++-- Self-contained descriptors: offline with an empty Dhall cache.+recipe :: Text+recipe =+  T.unlines+    [ "let Var = { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      "let Prompt = { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      "in { name = \"my-stack\", version = None Text, description = None Text",+      ", modules = [{module = \"demo\", vars = [{name = \"member.only\", value = \"literal\"}]}]",+      ", vars = [ { name = \"github.enabled\", type = \"bool\", default = None Text, description = None Text, required = True, validation = None Text }",+      "         , { name = \"redpanda.enabled\", type = \"bool\", default = None Text, description = None Text, required = True, validation = None Text }",+      "         , { name = \"github.owner\", type = \"text\", default = None Text, description = None Text, required = True, validation = None Text } ]",+      ", prompts = [{var = \"github.owner\", text = \"Owner?\", when = Some \"Eq github.enabled true\", choices = None (List Text)}]",+      "}"+    ]++invoke :: FilePath -> FilePath -> FilePath -> [String] -> IO (ExitCode, Text)+invoke binary root cwd args = do+  inherited <- getEnvironment+  let overrides = [("XDG_CONFIG_HOME", root </> "config"), ("XDG_CACHE_HOME", root </> "cache"), ("XDG_DATA_HOME", root </> "data"), ("XDG_STATE_HOME", root </> "state")]+      environment = overrides <> filter (\(key, _) -> key `notElem` map fst overrides) inherited+  result <- timeout (15 * 1000000) $ readCreateProcessWithExitCode (proc binary args) {cwd = Just cwd, env = Just environment} ""+  case result of+    Nothing -> expectationFailure "validate-recipe did not terminate with closed stdin" >> pure (ExitFailure 99, "timeout")+    Just (code, out, err) -> pure (code, T.pack (out <> err))++-- Record directory entries as well as bytes. Only Dhall's evaluator cache is+-- excluded; Seihou's cache and all configuration/install state are included.+snapshot :: FilePath -> IO [(FilePath, Maybe BS.ByteString)]+snapshot root = go ""+  where+    go relative = do+      entries <- sort <$> D.listDirectory (root </> relative)+      fmap concat $ forM entries $ \entry -> do+        let path = relative </> entry+        if path == "cache/dhall"+          then pure []+          else do+            directory <- D.doesDirectoryExist (root </> path)+            if directory+              then ((path, Nothing) :) <$> go path+              else do+                bytes <- BS.readFile (root </> path)+                pure [(path, Just bytes)]++prepareState :: FilePath -> IO ()+prepareState root = do+  forM_ ["config/seihou/installed", "cache", "data", "state"] $ \dir -> D.createDirectoryIfMissing True (root </> dir)+  -- An invalid personal configuration must not be read by this command.+  TIO.writeFile (root </> "config/seihou/config.dhall") "not valid configuration"+  TIO.writeFile (root </> "config/seihou/installed/sentinel") "preserve me"++tests :: IO TestTree+tests = testSpec "ValidateRecipe" $ do+  it "validates unanswered conditional inputs with effectful members present, absent and on repeat" $+    withSystemTempDirectory "validate-recipe" $ \root -> do+      (binary, member) <- prepare root+      prepareState root+      TIO.writeFile+        (member </> "module.dhall")+        "let S = ./schema/package.dhall in S.Module::{name=\"demo\",version=Some \"1.0.0\",vars=[S.VarDecl::{name=\"answer\",type=\"text\",required=True}],prompts=[S.Prompt::{var=\"answer\",text=\"Answer?\"}],steps=[S.Step::{strategy=\"copy\",src=\"starter\",dest=\"generated.txt\"}],commands=[S.Command::{action=S.Command.Action.Apply \"touch command-marker\"}]}"+      (memberCode, memberOutput) <- invoke binary root root ["validate-module", member]+      if memberCode == ExitSuccess then pure () else expectationFailure (T.unpack memberOutput)+      let dir = root </> "recipe with spaces"+      D.createDirectory dir+      TIO.writeFile (dir </> "recipe.dhall") recipe+      forM_ [False, True] $ \removeMember -> do+        if removeMember then D.removePathForcibly member else pure ()+        forM_ [["validate-recipe", "recipe with spaces"], ["validate-recipe"]] $ \args -> do+          before <- snapshot root+          (code, output) <- invoke binary root (if length args == 1 then dir else root) args+          (code, output) `shouldBe` (ExitSuccess, "Recipe 'my-stack' is valid.\n")+          snapshot root `shouldReturn` before++  it "supports the ordinary new-recipe workflow without members or configuration" $+    withSystemTempDirectory "validate-recipe-scaffold" $ \root -> do+      binary <- seihouBinary+      (created, _) <- invoke binary root root ["new-recipe", "my-stack", "--module", "unpublished-member"]+      created `shouldBe` ExitSuccess+      before <- snapshot root+      (code, output) <- invoke binary root root ["validate-recipe", "my-stack"]+      code `shouldBe` ExitSuccess+      output `shouldSatisfy` T.isInfixOf "Recipe 'my-stack' is valid."+      snapshot root `shouldReturn` before++  it "reports missing descriptors with exit 4" $+    withSystemTempDirectory "validate-recipe-missing" $ \root -> do+      binary <- seihouBinary+      (code, output) <- invoke binary root root ["validate-recipe"]+      code `shouldBe` ExitFailure 4+      output `shouldSatisfy` T.isInfixOf "recipe.dhall not found"++  forM_ negativeCases $ \(label, descriptor, contexts) ->+    it ("rejects " <> label <> " without effects") $+      withSystemTempDirectory "validate-recipe-invalid" $ \root -> do+        binary <- seihouBinary+        prepareState root+        TIO.writeFile (root </> "recipe.dhall") descriptor+        before <- snapshot root+        (code, output) <- invoke binary root root ["validate-recipe"]+        code `shouldBe` ExitFailure 1+        forM_ ("recipe.dhall" : "invalid" : contexts) $ \context -> output `shouldSatisfy` T.isInfixOf context+        output `shouldSatisfy` (not . T.isInfixOf "DhallEvalError")+        snapshot root `shouldReturn` before++negativeCases :: [(String, Text, [Text])]+negativeCases =+  [ ("malformed Dhall", "{ invalid =", ["Invalid input"]),+    ("missing fields", "{name = \"my-stack\"}", ["missing fields", "modules", "vars", "prompts"]),+    ("non-record descriptor", "True", ["recipe record"]),+    ("wrong vars shape", replace "required = True" "required = \"yes\"", ["vars", "required"]),+    ("wrong field shape", replace "modules = [{module = \"demo\", vars = [{name = \"member.only\", value = \"literal\"}]}]" "modules = True", ["modules"]),+    ("invalid type", replace "type = \"bool\"" "type = \"mystery\"", ["type", "mystery"]),+    ("invalid nested type", replace "type = \"bool\"" "type = \"list mystery\"", ["type", "mystery"]),+    ("invalid default", replace "type = \"bool\", default = None Text" "type = \"bool\", default = Some \"invalid\"", ["default", "github.enabled"]),+    ("invalid condition syntax", replace "Eq github.enabled true" "Eq github.enabled", ["prompts", "github.owner", "when"]),+    ("empty members", replace "modules = [{module = \"demo\", vars = [{name = \"member.only\", value = \"literal\"}]}]" "modules = [] : List Text", ["modules", "at least one"]),+    ("invalid name", replace "name = \"my-stack\"" "name = \"BadName\"", ["name", "BadName"]),+    ("duplicate members", replace "modules = [{module = \"demo\", vars = [{name = \"member.only\", value = \"literal\"}]}]" "modules = [\"demo\", \"demo\"]", ["modules", "duplicate", "demo"]),+    ("invalid binding", replace "member.only" "INVALID", ["modules.vars", "INVALID", "demo"]),+    ("duplicate declarations", replace "name = \"redpanda.enabled\"" "name = \"github.enabled\"", ["vars", "duplicate", "github.enabled"]),+    ("undeclared target", replace "var = \"github.owner\"" "var = \"missing\"", ["prompts", "missing", "vars"]),+    ("nested undeclared condition", replace "Eq github.enabled true" "Eq github.enabled true || !(IsSet missing)", ["prompts", "github.owner", "when", "missing"]),+    ("multiple semantic errors", T.replace "var = \"github.owner\"" "var = \"missing\"" (replace "name = \"my-stack\"" "name = \"BadName\""), ["name", "BadName", "prompts", "missing"]),+    ("missing local import", "./missing.dhall", ["missing.dhall"])+  ]+  where+    replace old new = T.replace old new recipe