seihou-core 0.11.0.1 → 0.12.0.0

raw patch · 25 files changed

+587/−121 lines, 25 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• seihou-core.cabal +1/−1
• src/Seihou/Composition/Recipe.hs +3/−3
• src/Seihou/Composition/Resolve.hs +134/−2
• src/Seihou/Core/Application.hs +1/−0
• src/Seihou/Core/Blueprint.hs +28/−20
• src/Seihou/Core/Recipe.hs +24/−3
• src/Seihou/Core/Types.hs +5/−2
• src/Seihou/Dhall/Eval.hs +98/−22
• src/Seihou/Interaction/Prompt.hs +42/−35
• src/Seihou/Manifest/Types.hs +9/−2
• src/Seihou/Manifest/Upgrade.hs +16/−1
• test/Seihou/Composition/GraphSpec.hs +4/−4
• test/Seihou/Composition/RecipeSpec.hs +26/−9
• test/Seihou/Composition/ResolveSpec.hs +6/−6
• test/Seihou/Core/ApplicationSpec.hs +1/−0
• test/Seihou/Core/BlueprintSpec.hs +2/−2
• test/Seihou/Core/RecipeSpec.hs +35/−2
• test/Seihou/Core/SeedSpec.hs +1/−0
• test/Seihou/Dhall/EvalSpec.hs +45/−1
• test/Seihou/Engine/CheckoutSpec.hs +1/−1
• test/Seihou/Engine/RemoveSpec.hs +1/−1
• test/Seihou/Engine/SeedTransactionSpec.hs +1/−1
• test/Seihou/Interaction/PromptSpec.hs +81/−2
• test/Seihou/Manifest/TypesSpec.hs +15/−1
• test/Seihou/Manifest/UpgradeSpec.hs +7/−0

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-core-version: 0.11.0.1+version: 0.12.0.0 synopsis: Core library for Seihou project scaffolding description:   Core library for Seihou, a composable project scaffolding system.

@@ -11,11 +11,11 @@ import Seihou.Core.Recipe (validateRecipe) import Seihou.Core.Types -type ExpandedRecipe = (ModuleName, [ModuleName], Map VarName Text, [VarDecl], [Prompt])+type ExpandedRecipe = (ModuleName, [ModuleName], Map VarName Text, [VarDecl], [Prompt], [Dependency])  -- | Expand a 'Recipe' into the inputs that the existing composition pipeline -- expects: a primary module name, additional module names, variable overrides,--- recipe-level variable declarations, and recipe-level prompts.+-- recipe-level variable declarations, prompts, and intact source requirements. -- -- The first module in the recipe's list becomes the primary module (used for -- config namespace derivation). All remaining modules become additional modules.@@ -29,4 +29,4 @@       let primaryName = (primary ^. #module_)           additionalNames = map (^. #module_) additional           overrides = Map.unions (map (^. #vars) (validated ^. #modules))-       in Right (primaryName, additionalNames, overrides, validated ^. #vars, validated ^. #prompts)+       in Right (primaryName, additionalNames, overrides, validated ^. #vars, validated ^. #prompts, validated ^. #modules)

@@ -1,29 +1,39 @@ module Seihou.Composition.Resolve   ( loadComposition,+    verifyDependencySources,     SavedInstanceValues,     PromptPermission (..),     resolveComposedVariables,     resolveComposedVariablesWithSaved,     resolveWithPrompts,     resolveWithPromptPermission,+    RecipeInputSpec (..),+    resolveRecipeWithPrompts,+    varValueToText,     exportedVars,     collectParentVars,   ) where +import Control.Monad (unless)+import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Generics.Labels ()+import Data.List (find) import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe) import Data.Set qualified as Set import Data.Text qualified as T import Seihou.Composition.Graph (buildGraph, topoSort) import Seihou.Composition.Instance (ModuleInstance (..), mkInstance, primaryInstance)+import Seihou.Core.ArtifactIdentity (normalizeOriginUrl)+import Seihou.Core.ArtifactOriginDetect (OriginInfo (..), readOriginInfo) import Seihou.Core.Module (discoverModule, validateModule) import Seihou.Core.Types-import Seihou.Core.Variable (resolveVariablesWithSaved)+import Seihou.Core.Variable (coerceValue, resolveVariablesWithSaved) import Seihou.Dhall.Eval (evalModuleFromFile) import Seihou.Effect.Console (Console, isInteractive, putText)-import Seihou.Interaction.Prompt (runPrompts)+import Seihou.Interaction.Prompt (promptForVar, runPrompts, runPromptsChecked) import Seihou.Prelude  -- | Values captured by a previously accepted composition, kept distinct per@@ -55,6 +65,7 @@       loaded = Map.singleton primaryInst (effectivePrimary, primaryDir)       seeds = [(mkInstance (dep ^. #module_) (parentVarsFromDep dep)) | dep <- effectivePrimary ^. #dependencies]   allInstances <- ExceptT $ loadTransitive searchPaths loaded seeds+  mapM_ (\(inst, (m, dir)) -> ExceptT (verifyDependencySources searchPaths dir ((if inst == primaryInst then primaryMod else m) ^. #dependencies))) (Map.toList allInstances)   let entries = [(inst, m) | (inst, (m, _)) <- Map.toList allInstances]       graph = buildGraph entries   order <- ExceptT . pure $ topoSort graph@@ -279,6 +290,100 @@                             (Map.insert inst fullResolved perModule)                             (Map.insert inst myExports allExports) +-- | Recipe declarations are resolved before any consuming module defaults.+-- Nothing denotes historical inputs that have not yet been adopted; Just empty+-- records an accepted omission of all optional inputs.+data RecipeInputSpec = RecipeInputSpec [VarDecl] [Prompt] (Maybe (Map VarName Text))++resolveRecipeWithPrompts ::+  (Console :> es) =>+  PromptPermission ->+  Bool ->+  RecipeInputSpec ->+  [(ModuleInstance, Module, FilePath)] ->+  SavedInstanceValues ->+  Map VarName Text ->+  Map VarName Text ->+  Map Text Text ->+  Text ->+  Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Eff es (Either [VarError] (Map VarName ResolvedVar, Map ModuleInstance (Map VarName ResolvedVar)))+resolveRecipeWithPrompts permission confirmRecipe (RecipeInputSpec decls prompts recorded) modules saved cli literals env ns ctx local nsCfg ctxCfg global = do+  interactive <- case permission of+    PromptsForbidden -> pure False+    PromptsAllowed -> isInteractive+  let explicit = Map.union cli literals+      historical d =+        nubOrdBy+          id+          [ either (const raw) varValueToText (coerceValue (d ^. #name) (d ^. #type_) raw)+          | (inst, m, _) <- modules,+            any ((== d ^. #name) . (^. #name)) (m ^. #vars),+            Just raw <- [Map.lookup inst saved >>= Map.lookup (d ^. #name)]+          ]+      conflicts =+        [ ValidationFailed (d ^. #name) ("conflicting saved recipe inputs; supply --var " <> d ^. #name . #unVarName <> "=VALUE or use --reconfigure")+        | d <- decls,+          recorded == Nothing,+          not (Map.member (d ^. #name) explicit),+          length (historical d) > 1+        ]+      replay = fromMaybe (Map.fromList [(d ^. #name, raw) | d <- decls, [raw] <- [historical d]]) recorded+      results = [resolveVariablesWithSaved [d] explicit replay env ns ctx local nsCfg ctxCfg global Map.empty | d <- decls]+      values = Map.unions [v | Right v <- results]+      errors = concat [e | Left e <- results]+      (_, fatal) = partitionErrors errors+  if not (null (conflicts ++ fatal))+    then pure (Left (conflicts ++ fatal))+    else do+      confirmed <- if interactive && confirmRecipe then confirmValues (Map.toList values) values else pure (Right values)+      case confirmed of+        Left errs -> pure (Left errs)+        Right initial -> do+          let missing = [d | d <- decls, not (Map.member (d ^. #name) initial)]+              eligible = case recorded of+                Just _ -> filter (^. #required) missing+                Nothing -> missing+              required = filter (^. #required) eligible+              optional = filter (not . (^. #required)) eligible+          firstAnswers <- if interactive then runPromptsChecked prompts required (Map.map (^. #value) initial) else pure (Right Map.empty)+          case firstAnswers of+            Left errs -> pure (Left errs)+            Right answers -> do+              let current = Map.union answers initial+              secondAnswers <- if interactive then runPromptsChecked prompts optional (Map.map (^. #value) current) else pure (Right Map.empty)+              case secondAnswers of+                Left errs -> pure (Left errs)+                Right extras -> do+                  let recipeValues = Map.union extras current+                      omissions = [MissingRequiredVar (d ^. #name) | d <- decls, d ^. #required, not (Map.member (d ^. #name) recipeValues)]+                      broadcast = Map.map (varValueToText . (^. #value)) recipeValues+                  if not (null omissions)+                    then pure (Left omissions)+                    else do+                      let owned = Set.fromList (map (^. #name) decls)+                          consumers = [(i, m & #prompts %~ filter (\p -> not (Set.member (p ^. #var) owned)), dir) | (i, m, dir) <- modules]+                      resolved <- resolveWithPromptPermission permission consumers saved (Map.union explicit broadcast) env ns ctx local nsCfg ctxCfg global+                      pure $ fmap (\perModule -> (recipeValues, Map.map (Map.mapWithKey (restoreSource recipeValues)) perModule)) resolved+  where+    restoreSource recipeValues name rv = case Map.lookup name recipeValues of+      Just recipeValue | not (Map.member name cli || Map.member name literals) -> rv & #source .~ recipeValue ^. #source+      _ -> rv+    confirmValues [] acc = pure (Right acc)+    confirmValues ((name, rv) : rest) acc+      | rv ^. #source /= FromDefault = confirmValues rest acc+      | otherwise = do+          let decl = rv ^. #decl+              prompt = fromMaybe (Prompt name (name ^. #unVarName) Nothing Nothing) (find ((== name) . (^. #var)) prompts)+          answer <- promptForVar prompt decl (Map.map (^. #value) acc)+          case answer of+            Left err -> pure (Left [err])+            Right accepted -> confirmValues rest (Map.insert name accepted acc)+ -- | Collect the exports visible along a module's dependency edges. -- -- Each dependency edge is resolved to the exact child instance@@ -440,3 +545,30 @@     go seen (x : xs)       | Set.member (f x) seen = go seen xs       | otherwise = x : go (Set.insert (f x) seen) xs++-- | Verify producer requirements locally, including on the first generation.+-- A local shadow without provenance cannot satisfy an explicit source.+verifyDependencySources :: [FilePath] -> FilePath -> [Dependency] -> IO (Either ModuleLoadError ())+verifyDependencySources paths _declaringDir deps = runExceptT $ do+  mapM_ check deps+  where+    check dep = case dep ^. #source of+      Nothing -> pure ()+      Just required -> do+        let name = dep ^. #module_+        dir <- ExceptT (discoverModule paths name)+        actual <- liftIO (readOriginInfo dir)+        unless (maybe False (\info -> normalizeOriginUrl (info ^. #sourceUrl) == normalizeOriginUrl required) actual) $+          ExceptT $+            pure $+              Left $+                ValidationError+                  name+                  [ "Dependency '"+                      <> name ^. #unModuleName+                      <> "' requires "+                      <> required+                      <> "; resolved copy at "+                      <> T.pack dir+                      <> " has different or unknown provenance. Reinstall the declaring artifact and remove or correct the local shadow."+                  ]

@@ -66,6 +66,7 @@       instances = map buildInstance modulesInOrder,       commandReceipts = Map.empty,       checkoutCommands = [],+      recipeInputs = Nothing,       appliedAt = now     }   where

@@ -1,6 +1,7 @@ module Seihou.Core.Blueprint   ( validateBlueprint,     validateBlueprintWith,+    validateBlueprintForInstall,     checkBlueprintNameFormat,     checkBlueprintVersionPresent,     checkBlueprintPromptNonEmpty,@@ -77,8 +78,18 @@   Blueprint ->   IO (Either ModuleLoadError Blueprint) validateBlueprintWith searchPaths baseDir b = do-  fileErrs <- checkBlueprintFiles baseDir b   baseErrs <- checkBlueprintBaseModulesWith searchPaths b+  validateBlueprintDefinition baseDir b baseErrs++-- | Acquisition validates references against fetched registries, not the user's+-- local cache. All declaration and payload checks still apply before install.+validateBlueprintForInstall :: FilePath -> Blueprint -> IO (Either ModuleLoadError Blueprint)+validateBlueprintForInstall baseDir b =+  validateBlueprintDefinition baseDir b (concatMap baseDeclarationErrors (b ^. #baseModules))++validateBlueprintDefinition :: FilePath -> Blueprint -> [Text] -> IO (Either ModuleLoadError Blueprint)+validateBlueprintDefinition baseDir b baseErrs = do+  fileErrs <- checkBlueprintFiles baseDir b   let pureErrs =         checkBlueprintNameFormat b           <> checkBlueprintVersionPresent b@@ -158,15 +169,6 @@     checkOne :: [FilePath] -> Dependency -> IO [Text]     checkOne paths dep = do       let n = (dep ^. #module_ . #unModuleName)-          nameErrs =-            [ "invalid baseModule name: " <> n-            | not (isValidModuleName n)-            ]-          bindingErrs =-            [ "baseModule '" <> n <> "' has invalid var binding name: " <> vn-            | (VarName vn) <- Map.keys (dep ^. #vars),-              not (isValidVarBindingName vn)-            ]       resolveErrs <-         if not (isValidModuleName n)           then pure []@@ -184,16 +186,7 @@                 ["baseModule '" <> n <> "' not found in any search path"]               Left _ ->                 ["baseModule '" <> n <> "' failed to load"]-      pure (nameErrs <> bindingErrs <> resolveErrs)--    isValidVarBindingName :: Text -> Bool-    isValidVarBindingName t = case T.uncons t of-      Nothing -> False-      Just (c, rest) ->-        (c >= 'a' && c <= 'z')-          && T.all-            (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-' || ch == '.')-            rest+      pure (baseDeclarationErrors dep <> resolveErrs)  -- Rule 7: every @files@ entry's source must exist on disk relative to -- @baseDir/files/@@@ -377,3 +370,18 @@   | Just probe <- [b ^. #versionProbe],     T.null (T.strip probe)   ]++baseDeclarationErrors :: Dependency -> [Text]+baseDeclarationErrors dep =+  let n = dep ^. #module_ . #unModuleName+   in ["invalid baseModule name: " <> n | not (isValidModuleName n)]+        <> ["baseModule '" <> n <> "' has invalid var binding name: " <> vn | VarName vn <- Map.keys (dep ^. #vars), not (isValidVarBindingName vn)]+  where+    isValidVarBindingName :: Text -> Bool+    isValidVarBindingName t = case T.uncons t of+      Nothing -> False+      Just (c, rest) ->+        (c >= 'a' && c <= 'z')+          && T.all+            (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-' || ch == '.')+            rest

@@ -9,6 +9,7 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T+import Seihou.Core.Expr (exprRefs) import Seihou.Core.Module (isValidModuleName) import Seihou.Core.Types @@ -21,6 +22,8 @@ --   2. At least one module listed --   3. No duplicate module names in the list --   4. All variable binding names in module entries match @[a-z][a-z0-9.-]*@+--   5. Recipe variable declarations are unique+--   6. Prompt targets and condition references name declared recipe variables validateRecipe :: Recipe -> Either [Text] Recipe validateRecipe recipe =   let errs =@@ -28,6 +31,7 @@           <> checkNonEmptyModules recipe           <> checkNoDuplicateModules recipe           <> checkVarBindingNames recipe+          <> checkRecipeVarsAndPrompts recipe    in if null errs         then Right recipe         else Left errs@@ -43,14 +47,14 @@ -- Rule 2: At least one module must be listed checkNonEmptyModules :: Recipe -> [Text] checkNonEmptyModules recipe-  | null (recipe ^. #modules) = ["recipe must list at least one module"]+  | null (recipe ^. #modules) = ["modules: recipe must list at least one module"]   | otherwise = []  -- Rule 3: No duplicate module names checkNoDuplicateModules :: Recipe -> [Text] checkNoDuplicateModules recipe =   let names = map (^. #module_ . #unModuleName) (recipe ^. #modules)-   in map (\n -> "duplicate module in recipe: " <> n) (findDupes Set.empty Set.empty names)+   in map (\n -> "modules: duplicate module in recipe: " <> n) (findDupes Set.empty Set.empty names)  findDupes :: Set.Set Text -> Set.Set Text -> [Text] -> [Text] findDupes _ _ [] = []@@ -68,7 +72,7 @@         ( \(VarName vn) ->             if isValidVarBindingName vn               then []-              else ["invalid var binding name '" <> vn <> "' in module '" <> dep ^. #module_ . #unModuleName <> "'"]+              else ["modules.vars: invalid var binding name '" <> vn <> "' in module '" <> dep ^. #module_ . #unModuleName <> "'"]         )         (Map.keys (dep ^. #vars)) @@ -78,3 +82,20 @@       Just (c, rest) ->         (c >= 'a' && c <= 'z')           && T.all (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-' || ch == '.') rest++-- Descriptor-local checks deliberately require no values or member schemas.+checkRecipeVarsAndPrompts :: Recipe -> [Text]+checkRecipeVarsAndPrompts recipe =+  let names = map (^. #name . #unVarName) (recipe ^. #vars)+      declared = Set.fromList names+      undeclared (VarName name) = Set.notMember name declared+      promptErrors prompt =+        let target = prompt ^. #var . #unVarName+            refs = maybe [] exprRefs (prompt ^. #condition)+         in ["prompts: target '" <> target <> "' is undeclared; add it to vars" | undeclared (prompt ^. #var)]+              <> [ "prompts: '" <> target <> "' when references undeclared variable '" <> ref <> "'; add it to vars"+                 | (name@(VarName ref), _) <- refs,+                   undeclared name+                 ]+   in map (\name -> "vars: duplicate variable declaration '" <> name <> "'") (findDupes Set.empty Set.empty names)+        <> concatMap promptErrors (recipe ^. #prompts)

@@ -249,13 +249,14 @@ -- defaults in the precedence chain. data Dependency = Dependency   { module_ :: !ModuleName,-    vars :: !(Map VarName Text)+    vars :: !(Map VarName Text),+    source :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic)  -- | Create a bare dependency with no variable bindings. simpleDep :: ModuleName -> Dependency-simpleDep name = Dependency {module_ = name, vars = mempty}+simpleDep name = Dependency {module_ = name, vars = mempty, source = Nothing}  -- | Extract module names from a list of dependencies. depModuleNames :: [Dependency] -> [ModuleName]@@ -597,6 +598,7 @@     -- explicit shared-write evidence introduced by schema 7.     TargetedAdditiveSharedPathUpdate   | SeedReceipts+  | RecipeInputs   | SeedOwnerClaims   | CheckoutLocalOutputs   | CheckoutLocalCommands@@ -751,6 +753,7 @@     instances :: ![AppliedInstanceState],     commandReceipts :: !(Map CommandFingerprint CommandReceipt),     checkoutCommands :: ![CheckoutCommand],+    recipeInputs :: !(Maybe (Map VarName Text)),     appliedAt :: !UTCTime   }   deriving stock (Eq, Show, Generic)

@@ -1,5 +1,7 @@ module Seihou.Dhall.Eval-  ( evalDhallExpr,+  ( normalizeDhallFile,+    normalizeInstalledDefinition,+    evalDhallExpr,     evalModuleFromFile,     evalRecipeFromFile,     evalBlueprintFromFile,@@ -42,10 +44,11 @@ import Data.Text.IO qualified as TIO import Data.Void (Void) import Dhall (defaultInputSettings, input, inputExprWithSettings, inputFile, list, record, rootDirectory, sourceName, strictText)-import Dhall.Core (Chunks (..), makeRecordField)+import Dhall.Core (Chunks (..), makeRecordField, recordFieldValue) import Dhall.Core qualified as Dhall (Expr (..)) import Dhall.Map qualified as DhallMap-import Dhall.Marshal.Decode (Decoder (..), Extractor, bool, constructor, field, maybe, natural, string, union)+import Dhall.Marshal.Decode (Decoder (..), Extractor, bool, constructor, extractError, field, maybe, natural, string, union)+import Dhall.Pretty (prettyExpr) import Dhall.Src (Src) import Seihou.Core.Expr (parseExpr) import Seihou.Core.Migration (BlueprintMigration (..), EntailedEdge (..), Migration (..), MigrationOp (..))@@ -96,6 +99,7 @@     expr <- inputExprWithSettings settings text     case extract moduleDecoder expr of       Success m -> do+        mapM_ evaluate (m ^. #dependencies)         -- Force lazy decoder thunks that may contain 'error' calls         mapM_ (\v -> evaluate (v ^. #type_)) (m ^. #vars)         mapM_ (\s -> evaluate (s ^. #lifecycle) >> evaluate (s ^. #strategy) >> evaluate (s ^. #condition) >> mapM_ evaluate (s ^. #patch)) (m ^. #steps)@@ -125,8 +129,9 @@     expr <- inputExprWithSettings settings text     case extract recipeDecoder expr of       Success r -> do+        mapM_ evaluate (r ^. #modules)         -- Force lazy decoder thunks that may contain 'error' calls-        mapM_ (\v -> evaluate (v ^. #type_)) (r ^. #vars)+        mapM_ (\v -> evaluate (forceType (v ^. #type_))) (r ^. #vars)         mapM_ (\p -> evaluate (p ^. #condition)) (r ^. #prompts)         pure r       Failure e -> throwIO e@@ -136,6 +141,14 @@        in pure $ Left (DhallEvalError name (T.pack (show e)))     Right r -> pure (Right r) +-- Evaluate nested type constructors within the recipe loader's exception boundary.+forceType :: VarType -> ()+forceType (VTList element) = forceType element+forceType VTText = ()+forceType VTBool = ()+forceType VTInt = ()+forceType (VTChoice _) = ()+ -- | Guess a module name from its file path by taking the parent directory name. guessModuleName :: FilePath -> ModuleName guessModuleName path =@@ -270,17 +283,35 @@  -- | Decoder for the top-level Recipe type from Dhall. recipeDecoder :: Decoder Recipe-recipeDecoder =-  record-    ( Recipe-        <$> field "name" recipeNameDecoder-        <*> field "version" (maybe strictText)-        <*> field "description" (maybe strictText)-        <*> field "modules" (list dependencyDecoder)-        <*> field "vars" (list varDeclDecoder)-        <*> field "prompts" (list promptDecoder)-    )+recipeDecoder = Decoder decodeRecipe (expected fieldsDecoder)+  where+    fieldsDecoder =+      record+        ( Recipe+            <$> field "name" (decodeContext "name: expected a recipe name as Text" recipeNameDecoder)+            <*> field "version" (decodeContext "version: expected Optional Text" (maybe strictText))+            <*> field "description" (decodeContext "description: expected Optional Text" (maybe strictText))+            <*> field "modules" (decodeContext "modules: expected a list of module names or records with module and vars bindings" (list dependencyDecoder))+            <*> field "vars" (decodeContext "vars: expected variable declarations with name, type, default, description, required and validation fields" (list varDeclDecoder))+            <*> field "prompts" (decodeContext "prompts: expected prompt records with var, text, when and choices fields" (list promptDecoder))+        ) +    decodeRecipe expr@(Dhall.RecordLit fields) =+      case filter (\key -> DhallMap.lookup key fields == Nothing) ["name", "version", "description", "modules", "vars", "prompts"] of+        [] -> extract fieldsDecoder expr+        missing -> extractError ("recipe.dhall: missing fields: " <> T.intercalate ", " missing)+    decodeRecipe _ = extractError "recipe.dhall: expected a recipe record"++-- Dhall extraction bypasses a single expected type to support both dependency+-- forms. Give extraction failures author-facing field context rather than an+-- internal InvalidDecoder report (which cannot name the enclosing field).+decodeContext :: Text -> Decoder a -> Decoder a+decodeContext context (Decoder decode expectedType) = Decoder decodeWithContext expectedType+  where+    decodeWithContext expr = case decode expr of+      Success value -> Success value+      Failure _ -> extractError context+ recipeNameDecoder :: Decoder RecipeName recipeNameDecoder = RecipeName <$> strictText @@ -339,6 +370,7 @@     expr <- inputExprWithSettings settings text     case extract blueprintDecoder expr of       Success b -> do+        mapM_ evaluate (b ^. #baseModules)         mapM_ (\v -> evaluate (v ^. #type_)) (b ^. #vars)         mapM_ (\p -> evaluate (p ^. #condition)) (b ^. #prompts)         pure b@@ -508,11 +540,13 @@      paramDepDecoder :: Decoder Dependency     paramDepDecoder =-      record-        ( mkDep-            <$> field "module" moduleNameDecoder-            <*> field "vars" (list varBindingDecoder)-        )+      withDefaults [("source", noneText)] $+        record+          ( mkDep+              <$> field "module" moduleNameDecoder+              <*> field "vars" (list varBindingDecoder)+              <*> field "source" (maybe strictText)+          )      varBindingDecoder :: Decoder (VarName, Text)     varBindingDecoder =@@ -522,8 +556,10 @@             <*> field "value" strictText         ) -    mkDep :: ModuleName -> [(VarName, Text)] -> Dependency-    mkDep name bindings = Dependency {module_ = name, vars = Map.fromList bindings}+    mkDep :: ModuleName -> [(VarName, Text)] -> Maybe Text -> Dependency+    mkDep name bindings src+      | Just value <- src, T.null (T.strip value) || "${" `T.isInfixOf` value = error "dependency source must be a nonempty literal Git source"+      | otherwise = Dependency {module_ = name, vars = Map.fromList bindings, source = src}  -- | Decoder for VarType from a Dhall Text string. -- Dhall does not support recursive types, so VarType is represented as a@@ -653,7 +689,11 @@       Prompt         { var = v,           text = t,-          condition = parseWhen whenText,+          condition = case whenText of+            Nothing -> Nothing+            Just source -> case parseExpr source of+              Right expr -> Just expr+              Left err -> errorWithoutStackTrace ("prompts: '" <> T.unpack (v ^. #unVarName) <> "' when: " <> T.unpack err <> " (" <> T.unpack source <> ")"),           choices = choices         } @@ -813,3 +853,39 @@     Left (e :: SomeException) ->       pure $ Left (RegistryEvalError (T.pack path) (T.pack (show e)))     Right r -> pure (Right r)++-- | Resolve imports while the source checkout is still available.+normalizeDhallFile :: FilePath -> IO Text+normalizeDhallFile path = do+  contents <- TIO.readFile path+  expr <- inputExprWithSettings (set rootDirectory (takeDirectory path) defaultInputSettings) contents+  pure (T.pack (show (prettyExpr expr)))++-- | Persist same-registry requirements at install time. Older installed files+-- keep legacy behavior until reinstall, rather than inferring new constraints.+normalizeInstalledDefinition :: Text -> FilePath -> IO Text+normalizeInstalledDefinition origin path = do+  contents <- TIO.readFile path+  expr <- inputExprWithSettings (set rootDirectory (takeDirectory path) defaultInputSettings) contents+  pure (T.pack (show (prettyExpr (rewrite expr))))+  where+    textLiteral value = Dhall.TextLit (Chunks [] value)+    sourceField = makeRecordField (Dhall.Some (textLiteral origin))+    bindingType = Dhall.Record (DhallMap.fromList [("name", makeRecordField Dhall.Text), ("value", makeRecordField Dhall.Text)])+    edge (Dhall.TextLit (Chunks [] name)) =+      Dhall.RecordLit+        ( DhallMap.fromList+            [("module", makeRecordField (textLiteral name)), ("vars", makeRecordField (Dhall.ListLit (Just (Dhall.App Dhall.List bindingType)) mempty)), ("source", sourceField)]+        )+    edge (Dhall.RecordLit fields) =+      case recordFieldValue <$> DhallMap.lookup "source" fields of+        Just (Dhall.Some _) -> Dhall.RecordLit fields+        _ -> Dhall.RecordLit (DhallMap.insert "source" sourceField fields)+    edge other = other+    rewrite (Dhall.RecordLit fields) = Dhall.RecordLit (foldl' update fields ["dependencies", "modules", "baseModules"])+    rewrite other = other+    update fields key = case recordFieldValue <$> DhallMap.lookup key fields of+      Just (Dhall.ListLit annotation values)+        | not (null values) ->+            DhallMap.insert key (makeRecordField (Dhall.ListLit annotation (fmap edge values))) fields+      _ -> fields

@@ -1,5 +1,6 @@ module Seihou.Interaction.Prompt   ( runPrompts,+    runPromptsChecked,     promptForVar,   ) where@@ -9,7 +10,7 @@ import Data.Text qualified as T import Seihou.Core.Expr (evalExpr) import Seihou.Core.Types-import Seihou.Core.Variable (coerceValue, validateVarValue)+import Seihou.Core.Variable (coerceDefault, coerceValue, validateVarValue) import Seihou.Effect.Console (Console, getLine, putText) import Seihou.Prelude import Prelude hiding (getLine)@@ -31,31 +32,43 @@   Map VarName VarValue ->   Eff es (Map VarName ResolvedVar) runPrompts prompts unresolvedDecls currentBindings =-  go prompts Map.empty+  either (const Map.empty) id <$> runPromptsInternal False prompts unresolvedDecls currentBindings++-- | Preserve exhausted invalid answers; an empty optional answer is a skip.+runPromptsChecked ::+  (Console :> es) =>+  [Prompt] ->+  [VarDecl] ->+  Map VarName VarValue ->+  Eff es (Either [VarError] (Map VarName ResolvedVar))+runPromptsChecked = runPromptsInternal True++runPromptsInternal ::+  (Console :> es) =>+  Bool ->+  [Prompt] ->+  [VarDecl] ->+  Map VarName VarValue ->+  Eff es (Either [VarError] (Map VarName ResolvedVar))+runPromptsInternal checked prompts unresolvedDecls currentBindings = go prompts Map.empty   where     declMap = Map.fromList [(d ^. #name, d) | d <- unresolvedDecls]--    go :: (Console :> es) => [Prompt] -> Map VarName ResolvedVar -> Eff es (Map VarName ResolvedVar)-    go [] acc = pure acc-    go (p : ps) acc = do-      let vn = (p ^. #var)-      -- Skip if variable is not in the unresolved set-      case Map.lookup vn declMap of-        Nothing -> go ps acc-        Just decl -> do-          -- Skip if already resolved by an earlier prompt-          if Map.member vn acc-            then go ps acc-            else do-              -- Evaluate when condition-              let allBindings = Map.union (Map.map (^. #value) acc) currentBindings-              if shouldPrompt p allBindings-                then do-                  result <- promptForVar p decl allBindings-                  case result of-                    Left _err -> go ps acc-                    Right rv -> go ps (Map.insert vn rv acc)-                else go ps acc+    go [] acc = pure (Right acc)+    go (p : ps) acc = case Map.lookup (p ^. #var) declMap of+      Nothing -> go ps acc+      Just decl+        | Map.member (p ^. #var) acc -> go ps acc+        | otherwise -> do+            let bindings = Map.union (Map.map (^. #value) acc) currentBindings+            if not (shouldPrompt p bindings)+              then go ps acc+              else do+                result <- promptForVar p decl bindings+                case result of+                  Left (MissingRequiredVar _) | not (decl ^. #required) -> go ps acc+                  Left err | checked -> pure (Left [err])+                  Left _ -> go ps acc+                  Right rv -> go ps (Map.insert (p ^. #var) rv acc)  -- | Check if a prompt should be displayed based on its @when@ condition. shouldPrompt :: Prompt -> Map VarName VarValue -> Bool@@ -94,16 +107,10 @@   raw <- getLine   if T.null (T.strip raw)     then case decl ^. #default_ of-      Just defVal ->-        -- Accept the default value-        pure-          ( Right-              ResolvedVar-                { value = defVal,-                  source = FromPrompt,-                  decl = decl-                }-          )+      Just defVal -> pure $ do+        val <- coerceDefault (decl ^. #name) (decl ^. #type_) defVal+        validateVarValue decl val+        Right ResolvedVar {value = val, source = FromPrompt, decl = decl}       Nothing         | not (decl ^. #required) ->             -- Optional variable with no default — skip@@ -152,7 +159,7 @@                in case coerceAndValidate decl chosen of                     Left err -> pure (Left err)                     Right rv -> pure (Right rv)-        _ -> pure (Left (MissingRequiredVar (decl ^. #name)))+        _ -> pure (Left (ValidationFailed (decl ^. #name) "invalid selection"))  -- | Coerce raw text to the variable's type and validate. coerceAndValidate :: VarDecl -> Text -> Either VarError ResolvedVar

@@ -25,7 +25,7 @@ import Data.ByteString.Lazy qualified as LBS import Data.Generics.Labels () import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, isJust) import Data.Set qualified as Set import Data.Text qualified as T import Data.Time (UTCTime)@@ -80,7 +80,7 @@ -- change advances this number is -- docs/adr/0014-every-semantic-manifest-change-advances-the-schema-version.md. currentManifestVersion :: ManifestSchemaVersion-currentManifestVersion = ManifestSchemaVersion 11+currentManifestVersion = ManifestSchemaVersion 12  -- | The oldest schema the ordinary decoder reads. Anything older records -- machine-specific absolute paths and must go through the explicit@@ -94,6 +94,7 @@ minimumManifestVersion :: ManifestCapability -> ManifestSchemaVersion minimumManifestVersion TargetedAdditiveSharedPathUpdate = ManifestSchemaVersion 7 minimumManifestVersion SeedReceipts = ManifestSchemaVersion 8+minimumManifestVersion RecipeInputs = ManifestSchemaVersion 12 minimumManifestVersion SeedOwnerClaims = ManifestSchemaVersion 11 minimumManifestVersion CheckoutLocalOutputs = ManifestSchemaVersion 9 minimumManifestVersion CheckoutLocalCommands = ManifestSchemaVersion 10@@ -397,6 +398,7 @@       ++ maybe [] (\v -> ["namespace" .= v]) (composition ^. #namespace)       ++ maybe [] (\v -> ["context" .= v]) (composition ^. #context)       ++ ["checkoutCommands" .= map checkoutCommandToJSON (composition ^. #checkoutCommands) | schema >= ManifestSchemaVersion 10]+      ++ ["recipeInputs" .= fmap varsToJSON (composition ^. #recipeInputs) | schema >= ManifestSchemaVersion 12]       ++ commandReceiptsField (composition ^. #commandReceipts)   where     commandReceiptsField receipts@@ -408,6 +410,9 @@  parseApplication :: ManifestSchemaVersion -> Aeson.Value -> Aeson.Parser AppliedComposition parseApplication schema = Aeson.withObject "AppliedComposition" $ \o -> do+  when (schema < minimumManifestVersion RecipeInputs) $ do+    legacyInputs <- o Aeson..:? "recipeInputs" :: Aeson.Parser (Maybe Aeson.Value)+    unless (legacyInputs == Nothing) (fail "recipe inputs require manifest schema 12")   commands <-     if schema >= ManifestSchemaVersion 10       then o .: "checkoutCommands" >>= mapM parseCheckoutCommand@@ -426,6 +431,7 @@     <*> o Aeson..:? "instances" Aeson..!= []     <*> (commandReceiptsFromJSON =<< o Aeson..:? "commandReceipts" Aeson..!= Aeson.object [])     <*> pure commands+    <*> (if schema >= ManifestSchemaVersion 12 then traverse varsFromJSON =<< o .: "recipeInputs" else pure Nothing)     <*> o .: "appliedAt"  instance ToJSON CommandReceipt where@@ -843,6 +849,7 @@ manifestEncodingLoss :: Manifest -> [Text] manifestEncodingLoss manifest =   either (pure . renderManifestInvariantError) (const []) (validateManifestInvariants manifest)+    <> ["recipe inputs require manifest schema 12" | not (manifestSupports RecipeInputs manifest), any (isJust . (^. #recipeInputs)) (manifest ^. #applications)]     <> ["seed owner claims require manifest schema 11" | not (manifestSupports SeedOwnerClaims manifest), any (\r -> case r ^. #ownership of KnownSeedOwners _ -> True; _ -> False) (Map.elems (manifest ^. #seeds))]     <> either (pure . T.pack) (const []) (Aeson.parseEither (const (validateCheckoutCommands manifest)) Aeson.Null)     <> ["removal commands cannot declare checkout setup" | applied <- manifest ^. #modules, removal <- maybe [] pure (applied ^. #removal), any ((== CheckoutCommandLifecycle) . (^. #lifecycle)) (removal ^. #commands)]

@@ -38,6 +38,7 @@ import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KeyMap import Data.Generics.Labels ()+import Data.Maybe (fromMaybe) import Data.Text qualified as T import Seihou.Core.Types import Seihou.Manifest.Types (currentManifestVersion, sharedWriteModeToText)@@ -58,6 +59,7 @@     MakeSharedWriteEvidenceExplicit   | AddEmptySeedReceipts   | AddEmptyCheckoutOutputs+  | AddUnknownRecipeInputs   | MakeSeedOwnershipExplicit   | AddEmptyCheckoutCommands   deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)@@ -121,13 +123,15 @@     step 7 AddEmptySeedReceipts "seed receipts",     step 8 AddEmptyCheckoutOutputs "checkout outputs",     step 9 AddEmptyCheckoutCommands "repeatable checkout commands",-    step 10 MakeSeedOwnershipExplicit "explicit seed instance ownership"+    step 10 MakeSeedOwnershipExplicit "explicit seed instance ownership",+    step 11 AddUnknownRecipeInputs "recipe inputs"   ]   where     step from stepAction =       ManifestUpgradeStep (ManifestSchemaVersion from) (ManifestSchemaVersion (from + 1)) stepAction  upgradeStepKind :: UpgradeStepAction -> UpgradeStepKind+upgradeStepKind AddUnknownRecipeInputs = LosslessUpgrade upgradeStepKind StampVersion = LosslessUpgrade upgradeStepKind ConvertMachineLocalPaths = InferenceBearingUpgrade upgradeStepKind MakeSharedWriteEvidenceExplicit = LosslessUpgrade@@ -189,6 +193,9 @@   unless (actual == upgradeStep ^. #fromVersion) $     Left (StepVersionMismatch upgradeStep actual)   transformed <- case upgradeStep ^. #action of+    AddUnknownRecipeInputs -> case document of+      Aeson.Object fields -> Right (Aeson.Object (KeyMap.insert "applications" (addInputs (fromMaybe (Aeson.Array mempty) (KeyMap.lookup "applications" fields))) fields))+      _ -> Right document     StampVersion -> Right document     MakeSeedOwnershipExplicit -> first (MalformedDocument actual) (makeSeedOwnershipExplicit document)     AddEmptyCheckoutCommands -> case document of@@ -319,3 +326,11 @@       pure (Aeson.Object (KeyMap.insert "ownership" ownership (KeyMap.delete "applications" receipt)))     convert _ _ = Left "seed receipt must be an object" makeSeedOwnershipExplicit _ = Left "manifest must be an object"++-- Historical applications have no known recipe-resolution record.+addInputs :: Aeson.Value -> Aeson.Value+addInputs (Aeson.Array apps) = Aeson.Array (fmap add apps)+  where+    add (Aeson.Object fields) = Aeson.Object (KeyMap.insert "recipeInputs" Aeson.Null fields)+    add other = other+addInputs other = other

@@ -141,8 +141,8 @@                 steps = [],                 commands = [],                 dependencies =-                  [ Dependency "helper" (Map.singleton "skill.name" "exec-plan"),-                    Dependency "helper" (Map.singleton "skill.name" "master-plan")+                  [ Dependency "helper" (Map.singleton "skill.name" "exec-plan") Nothing,+                    Dependency "helper" (Map.singleton "skill.name" "master-plan") Nothing                   ],                 removal = Nothing,                 migrations = []@@ -176,8 +176,8 @@                 steps = [],                 commands = [],                 dependencies =-                  [ Dependency "child" (Map.singleton "x" "1"),-                    Dependency "child" (Map.singleton "x" "1")+                  [ Dependency "child" (Map.singleton "x" "1") Nothing,+                    Dependency "child" (Map.singleton "x" "1") Nothing                   ],                 removal = Nothing,                 migrations = []

@@ -3,6 +3,7 @@ import Data.Map.Strict qualified as Map import Data.Text (Text) import Seihou.Composition.Recipe (expandRecipe)+import Seihou.Core.Recipe (validateRecipe) import Seihou.Core.Types import Test.Hspec import Test.Tasty@@ -11,7 +12,7 @@ tests :: IO TestTree tests = testSpec "Seihou.Composition.Recipe" spec -expectExpanded :: Recipe -> (ModuleName, [ModuleName], Map.Map VarName Text, [VarDecl], [Prompt])+expectExpanded :: Recipe -> (ModuleName, [ModuleName], Map.Map VarName Text, [VarDecl], [Prompt], [Dependency]) expectExpanded recipe =   case expandRecipe recipe of     Right expanded -> expanded@@ -28,15 +29,16 @@                 description = Nothing,                 modules =                   [ simpleDep "mod-a",-                    simpleDep "mod-b",+                    Dependency "mod-b" mempty (Just "https://example.com/registry"),                     simpleDep "mod-c"                   ],                 vars = [],                 prompts = []               }-          (primary, additional, _, _, _) = expectExpanded recipe+          (primary, additional, _, _, _, requirements) = expectExpanded recipe       primary `shouldBe` ModuleName "mod-a"       additional `shouldBe` [ModuleName "mod-b", ModuleName "mod-c"]+      requirements `shouldBe` [simpleDep "mod-a", Dependency "mod-b" mempty (Just "https://example.com/registry"), simpleDep "mod-c"]      it "collects variable overrides from module entries" $ do       let recipe =@@ -45,13 +47,13 @@                 version = Nothing,                 description = Nothing,                 modules =-                  [ Dependency (ModuleName "base") (Map.singleton "project.name" "my-app"),-                    Dependency (ModuleName "nix") (Map.singleton "nix.system" "aarch64-darwin")+                  [ Dependency (ModuleName "base") (Map.singleton "project.name" "my-app") Nothing,+                    Dependency (ModuleName "nix") (Map.singleton "nix.system" "aarch64-darwin") Nothing                   ],                 vars = [],                 prompts = []               }-          (_, _, overrides, _, _) = expectExpanded recipe+          (_, _, overrides, _, _, _) = expectExpanded recipe       Map.lookup (VarName "project.name") overrides `shouldBe` Just "my-app"       Map.lookup (VarName "nix.system") overrides `shouldBe` Just "aarch64-darwin" @@ -81,7 +83,7 @@                 vars = [recipeVar],                 prompts = [recipePrompt]               }-          (_, _, _, vars, prompts) = expectExpanded recipe+          (_, _, _, vars, prompts, _) = expectExpanded recipe       vars `shouldBe` [recipeVar]       prompts `shouldBe` [recipePrompt] @@ -95,7 +97,7 @@                 vars = [],                 prompts = []               }-          (primary, additional, overrides, _, _) = expectExpanded recipe+          (primary, additional, overrides, _, _, _) = expectExpanded recipe       primary `shouldBe` ModuleName "the-module"       additional `shouldBe` []       Map.null overrides `shouldBe` True@@ -110,4 +112,19 @@                 vars = [],                 prompts = []               }-      expandRecipe recipe `shouldBe` Left ["recipe must list at least one module"]+      expandRecipe recipe `shouldBe` Left ["modules: recipe must list at least one module"]++    it "shares rejection of malformed prompt targets and conditions with descriptor validation" $ do+      let recipe =+            Recipe+              "bad-prompts"+              Nothing+              Nothing+              [simpleDep "unavailable"]+              []+              [Prompt "missing-target" "Question" (Just (ExprNot (ExprIsSet "missing-condition"))) Nothing]+      case validateRecipe recipe of+        Left errors -> do+          length errors `shouldBe` 2+          expandRecipe recipe `shouldBe` Left errors+        Right _ -> expectationFailure "Expected malformed prompt references to fail"

@@ -410,7 +410,7 @@   describe "resolveComposedVariables (parameterized dependencies)" $ do     it "parent-supplied var resolves in dependency" $ do       let child = mkModule "child" [] [mkTextVar "skill.name" Nothing True] []-          parent' = mkModuleWithDeps "parent" [Dependency "child" (Map.singleton "skill.name" "exec-plan")] [] []+          parent' = mkModuleWithDeps "parent" [Dependency "child" (Map.singleton "skill.name" "exec-plan") Nothing] [] []           childInst = mkInstance "child" (ParentVars (Map.singleton "skill.name" "exec-plan"))           parentInst = primaryInstance "parent"           modules = [(childInst, child, "/fake/child"), (parentInst, parent', "/fake/parent")]@@ -423,7 +423,7 @@      it "parent-supplied var overrides dependency's default" $ do       let child = mkModule "child" [] [mkTextVar "skill.name" (Just (VText "old")) False] []-          parent' = mkModuleWithDeps "parent" [Dependency "child" (Map.singleton "skill.name" "new")] [] []+          parent' = mkModuleWithDeps "parent" [Dependency "child" (Map.singleton "skill.name" "new") Nothing] [] []           childInst = mkInstance "child" (ParentVars (Map.singleton "skill.name" "new"))           parentInst = primaryInstance "parent"           modules = [(childInst, child, "/fake/child"), (parentInst, parent', "/fake/parent")]@@ -436,7 +436,7 @@      it "CLI override beats parent-supplied var" $ do       let child = mkModule "child" [] [mkTextVar "skill.name" Nothing True] []-          parent' = mkModuleWithDeps "parent" [Dependency "child" (Map.singleton "skill.name" "from-parent")] [] []+          parent' = mkModuleWithDeps "parent" [Dependency "child" (Map.singleton "skill.name" "from-parent") Nothing] [] []           childInst = mkInstance "child" (ParentVars (Map.singleton "skill.name" "from-parent"))           parentInst = primaryInstance "parent"           modules = [(childInst, child, "/fake/child"), (parentInst, parent', "/fake/parent")]@@ -450,7 +450,7 @@      it "config beats parent-supplied var" $ do       let child = mkModule "child" [] [mkTextVar "skill.name" (Just (VText "default")) False] []-          parent' = mkModuleWithDeps "parent" [Dependency "child" (Map.singleton "skill.name" "parent-val")] [] []+          parent' = mkModuleWithDeps "parent" [Dependency "child" (Map.singleton "skill.name" "parent-val") Nothing] [] []           childInst = mkInstance "child" (ParentVars (Map.singleton "skill.name" "parent-val"))           parentInst = primaryInstance "parent"           modules = [(childInst, child, "/fake/child"), (parentInst, parent', "/fake/parent")]@@ -475,13 +475,13 @@           parentA =             mkModuleWithDeps               "parent-a"-              [Dependency "helper" (Map.singleton "skill.name" "exec-plan")]+              [Dependency "helper" (Map.singleton "skill.name" "exec-plan") Nothing]               []               []           parentB =             mkModuleWithDeps               "parent-b"-              [Dependency "helper" (Map.singleton "skill.name" "master-plan")]+              [Dependency "helper" (Map.singleton "skill.name" "master-plan") Nothing]               []               []           instA = mkInstance "helper" (ParentVars (Map.singleton "skill.name" "exec-plan"))

@@ -70,6 +70,7 @@       instances = [],       commandReceipts = Map.empty,       checkoutCommands = [],+      recipeInputs = Nothing,       appliedAt = fixedTime     } 

@@ -374,7 +374,7 @@       withSystemTempDirectory "seihou-test" $ \tmpDir -> do         let bad =               withBlueprintBaseModules-                [Dependency {module_ = "nope-not-here", vars = Map.empty}]+                [Dependency {module_ = "nope-not-here", vars = Map.empty, source = Nothing}]                 goodBlueprint         result <- validateBlueprintWith [tmpDir] tmpDir bad         case result of@@ -389,7 +389,7 @@         writeFile (nestedDir </> "blueprint.dhall") (sampleBlueprintDhall "nested-bp")         let bad =               withBlueprintBaseModules-                [Dependency {module_ = "nested-bp", vars = Map.empty}]+                [Dependency {module_ = "nested-bp", vars = Map.empty, source = Nothing}]                 goodBlueprint         result <- validateBlueprintWith [tmpDir] tmpDir bad         case result of

@@ -78,7 +78,7 @@                 version = Nothing,                 description = Nothing,                 modules =-                  [ Dependency (ModuleName "mod-a") (Map.singleton (VarName "INVALID") "val")+                  [ Dependency (ModuleName "mod-a") (Map.singleton (VarName "INVALID") "val") Nothing                   ],                 vars = [],                 prompts = []@@ -94,7 +94,7 @@                 version = Nothing,                 description = Nothing,                 modules =-                  [ Dependency (ModuleName "mod-a") (Map.singleton (VarName "nix.system") "aarch64-darwin")+                  [ Dependency (ModuleName "mod-a") (Map.singleton (VarName "nix.system") "aarch64-darwin") Nothing                   ],                 vars = [],                 prompts = []@@ -114,3 +114,36 @@       case validateRecipe recipe of         Left errs -> length errs `shouldSatisfy` (>= 2)         Right _ -> expectationFailure "Expected validation failure"++    it "accepts unanswered required declarations and nested conditions" $ do+      validateRecipe interactiveRecipe `shouldBe` Right interactiveRecipe++    it "reports duplicate declarations, prompt targets and all nested references together" $ do+      let recipe =+            Recipe+              "interactive"+              Nothing+              Nothing+              [simpleDep "unavailable"]+              [requiredVar "enabled", requiredVar "enabled"]+              [Prompt "missing-target" "Question" (Just (ExprAnd (ExprIsSet "unknown-a") (ExprNot (ExprOr (ExprLit True) (ExprEq "unknown-b" (VBool False)))))) Nothing]+      case validateRecipe recipe of+        Left errs -> do+          length errs `shouldBe` 4+          mapM_+            (\needle -> hasError needle errs `shouldBe` True)+            ["vars: duplicate", "missing-target", "unknown-a", "unknown-b"]+        Right _ -> expectationFailure "Expected all four descriptor errors"++requiredVar :: VarName -> VarDecl+requiredVar name = VarDecl name VTBool Nothing Nothing True Nothing++interactiveRecipe :: Recipe+interactiveRecipe =+  Recipe+    "interactive"+    Nothing+    Nothing+    [Dependency "unavailable" (Map.singleton "member.only" "literal ${unchanged}") Nothing]+    [requiredVar "enabled", requiredVar "owner"]+    [Prompt "owner" "Owner?" (Just (ExprAnd (ExprEq "enabled" (VBool True)) (ExprNot (ExprOr (ExprIsSet "owner") (ExprLit False))))) Nothing]

@@ -42,6 +42,7 @@           [AppliedInstanceState name emptyParentVars (LocalOrigin (name ^. #unModuleName)) Nothing Map.empty | name <- ["demo", "second"]]           Map.empty           []+          Nothing           now       exact = first & #ownership .~ claims a ["demo", "second"]       known = emptyManifest now & #applications .~ map application [a, b] & #seeds .~ Map.singleton "CHANGELOG.md" exact

@@ -7,7 +7,7 @@ import Data.Text qualified as T import Data.Text.IO qualified as TIO import Seihou.Core.Types-import Seihou.Dhall.Eval (evalDhallExpr, evalModuleFromFile, evalRecipeFromFile)+import Seihou.Dhall.Eval (evalDhallExpr, evalModuleFromFile, evalRecipeFromFile, normalizeInstalledDefinition) import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory)@@ -301,6 +301,23 @@                \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\                \}" +    it "preserves a declared source and its variable bindings" $+      withSystemTempDirectory "seihou-source" $ \dir -> do+        writeFile (dir </> "module.dhall") (emptyModuleWithDeps "[{ module = \"base\", source = Some \"https://example.com/registry.git\", vars = [{ name = \"x\", value = \"y\" }] }]")+        result <- evalModuleFromFile (dir </> "module.dhall")+        case result of+          Right m -> m ^. #dependencies `shouldBe` [Dependency "base" (Map.singleton "x" "y") (Just "https://example.com/registry.git")]+          Left err -> expectationFailure (show err)++    it "rejects a malformed source instead of dropping it" $+      withSystemTempDirectory "seihou-source" $ \dir -> do+        forM_ ["42", "Some \"\""] $ \sourceExpr -> do+          writeFile (dir </> "module.dhall") (emptyModuleWithDeps ("[{ module = \"base\", source = " <> sourceExpr <> ", vars = [] : List { name : Text, value : Text } }]"))+          result <- evalModuleFromFile (dir </> "module.dhall")+          case result of+            Left _ -> pure ()+            Right _ -> expectationFailure "malformed source was accepted"+     it "decodes a bare string dependency" $ do       withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do         writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[\"base\"]")@@ -313,6 +330,16 @@             (dep ^. #module_) `shouldBe` ModuleName "base"             Map.null (dep ^. #vars) `shouldBe` True +    it "roundtrips installed legacy names as typed dependencies with sources" $+      withSystemTempDirectory "seihou-source" $ \dir -> do+        let path = dir </> "module.dhall"+        writeFile path (emptyModuleWithDeps "[\"base\"]")+        normalizeInstalledDefinition "https://example.com/registry" path >>= TIO.writeFile path+        result <- evalModuleFromFile path+        case result of+          Right m -> m ^. #dependencies `shouldBe` [Dependency "base" mempty (Just "https://example.com/registry")]+          Left err -> expectationFailure (show err)+     it "decodes a parameterized record dependency" $ do       withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do         writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[{ module = \"base\", vars = [{ name = \"x\", value = \"y\" }] }]")@@ -350,6 +377,23 @@             Map.lookup (VarName "skill.name") (dep ^. #vars) `shouldBe` Just "exec-plan"    describe "evalRecipeFromFile" $ do+    it "returns contextual load errors for malformed recipe conditions, types and defaults" $ do+      withSystemTempDirectory "recipe-decoding" $ \tmpDir -> do+        let descriptor ty def condition =+              "{ name = \"probe\", version = None Text, description = None Text, modules = [\"unavailable\"], vars = [{ name = \"enabled\", type = \"" <> ty <> "\", default = " <> def <> ", description = None Text, required = True, validation = None Text }], prompts = [{ var = \"enabled\", text = \"Enable?\", when = " <> condition <> ", choices = None (List Text) }] }"+        forM_+          [ ("mystery", "None Text", "None Text", "type"),+            ("list mystery", "None Text", "None Text", "type"),+            ("bool", "Some \"invalid\"", "None Text", "enabled"),+            ("bool", "None Text", "Some \"Eq enabled\"", "prompts: 'enabled' when")+          ]+          $ \(ty, def, cond, context) -> do+            writeFile (tmpDir </> "recipe.dhall") (descriptor ty def cond)+            result <- evalRecipeFromFile (tmpDir </> "recipe.dhall")+            case result of+              Left (DhallEvalError _ message) -> message `shouldSatisfy` T.isInfixOf context+              other -> expectationFailure ("Expected controlled decode failure, got: " <> show other)+     it "decodes the haskell-with-nix-recipe fixture" $ do       result <- evalRecipeFromFile (fixtureDir </> "haskell-with-nix-recipe" </> "recipe.dhall")       case result of

@@ -37,7 +37,7 @@ fixtureManifest = emptyManifest now & #applications .~ [app] & #checkoutOutputs .~ Map.fromList [(dest, record source) | (dest, source) <- [(".local/config", "config/editor"), (".tool/assets", "assets/shared")]]   where     now = UTCTime (fromGregorian 2026 10 15) 0-    app = AppliedComposition (ApplicationId "a") (AppliedModuleTarget "demo") (LocalOrigin "demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (LocalOrigin "demo") (Just "1") Map.empty] Map.empty [] now+    app = AppliedComposition (ApplicationId "a") (AppliedModuleTarget "demo") (LocalOrigin "demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (LocalOrigin "demo") (Just "1") Map.empty] Map.empty [] Nothing now     record source = CheckoutOutputRecord (DirectorySymlink source) (Map.singleton (ApplicationId "a") (Set.singleton "demo"))  withFixture :: (FilePath -> IO a) -> IO a

@@ -81,7 +81,7 @@ spec = do   describe "seed preservation and exact selection" $ do     let appId = ApplicationId "a"-        app = AppliedComposition appId (AppliedModuleTarget modName) (LocalOrigin "test-module") Nothing [] Nothing Nothing [AppliedInstanceState name emptyParentVars (LocalOrigin text) Nothing Map.empty | (name, text) <- [(modName, "test-module"), (otherMod, "other-module")]] Map.empty [] fixedTime+        app = AppliedComposition appId (AppliedModuleTarget modName) (LocalOrigin "test-module") Nothing [] Nothing Nothing [AppliedInstanceState name emptyParentVars (LocalOrigin text) Nothing Map.empty | (name, text) <- [(modName, "test-module"), (otherMod, "other-module")]] Map.empty [] Nothing fixedTime         receipt = SeedRecord modName (KnownSeedOwners (Map.singleton appId (Set.fromList [modName, otherMod]))) SeedCreated fixedTime         manifest = mkManifest False [] & #applications .~ [app] & #seeds .~ Map.singleton "seed.txt" receipt     it "retires a no-spec instance without losing a co-seeder or original supplier" $ do

@@ -29,7 +29,7 @@ tests = testSpec "seed update transactions" $ do   let now = UTCTime (fromGregorian 2026 10 26) 0       appId = ApplicationId "app"-      app = AppliedComposition appId (AppliedModuleTarget "seeder") (LocalOrigin "seeder") Nothing [] Nothing Nothing [AppliedInstanceState "seeder" emptyParentVars (LocalOrigin "seeder") Nothing Map.empty] Map.empty [] now+      app = AppliedComposition appId (AppliedModuleTarget "seeder") (LocalOrigin "seeder") Nothing [] Nothing Nothing [AppliedInstanceState "seeder" emptyParentVars (LocalOrigin "seeder") Nothing Map.empty] Map.empty [] Nothing now       manifest = emptyManifest now & #applications .~ [app]       claims = Map.singleton appId (Set.singleton "seeder")       createAction = SeedAction "seed.txt" "seeder" claims SeedWrite (Just "seed bytes\n")

@@ -1,12 +1,12 @@ module Seihou.Interaction.PromptSpec (tests) where -import Control.Lens ((^.))+import Control.Lens ((&), (.~), (^.)) import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Text (Text) import Effectful import Seihou.Composition.Instance (primaryInstance)-import Seihou.Composition.Resolve (PromptPermission (..), resolveWithPromptPermission, resolveWithPrompts)+import Seihou.Composition.Resolve (PromptPermission (..), RecipeInputSpec (..), resolveRecipeWithPrompts, resolveWithPromptPermission, resolveWithPrompts) import Seihou.Core.Types import Seihou.Effect.ConsolePure import Seihou.Interaction.Prompt (promptForVar, runPrompts)@@ -94,6 +94,85 @@  spec :: Spec spec = do+  describe "recipe input resolution" $ do+    let feature = mkBoolVar "feature" Nothing True+        consumer = mkModule "consumer" [] [mkBoolVar "feature" (Just (VBool False)) False] [] []+        modules = [(primaryInstance "consumer", consumer, "/fixture")]+        resolve permission spec saved cli literals local =+          resolveRecipeWithPrompts permission False spec modules saved cli literals Map.empty "" "" local Map.empty Map.empty Map.empty+        recipe = RecipeInputSpec [feature] [mkPrompt "feature" "Feature?"] Nothing+    it "requires the recipe choice before considering a consumer default" $ do+      let (result, _) = runPureEff $ runConsolePureNonInteractive $ resolve PromptsForbidden recipe Map.empty Map.empty Map.empty Map.empty+      result `shouldBe` Left [MissingRequiredVar "feature"]+    it "broadcasts explicit false and retains prompt source" $ do+      let (result, console) = runPureEff $ runConsolePure ["false"] $ resolve PromptsAllowed recipe Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> expectationFailure (show errs)+        Right (inputs, values) -> do+          (inputs Map.! "feature") ^. #value `shouldBe` VBool False+          (values Map.! primaryInstance "consumer" Map.! "feature") ^. #source `shouldBe` FromPrompt+      console ^. #outputs `shouldBe` ["Feature?"]+    it "keeps CLI above literals, and literals above config" $ do+      let check cli literal local = fst $ runPureEff $ runConsolePureNonInteractive $ resolve PromptsForbidden recipe Map.empty cli literal local+      case check (Map.singleton "feature" "false") (Map.singleton "feature" "true") Map.empty of+        Right (inputs, _) -> (inputs Map.! "feature") ^. #value `shouldBe` VBool False+        Left errs -> expectationFailure (show errs)+      case check Map.empty (Map.singleton "feature" "false") (Map.singleton "feature" "true") of+        Right (inputs, _) -> (inputs Map.! "feature") ^. #value `shouldBe` VBool False+        Left errs -> expectationFailure (show errs)+    it "lets optional conditions see resolved siblings despite another missing input" $ do+      let details = mkTextVar "details" Nothing False+          spec =+            RecipeInputSpec+              [feature, mkBoolVar "other" Nothing True, details]+              [mkPrompt "other" "Other?", mkConditionalPrompt "details" "Details?" (ExprEq "feature" (VBool True))]+              Nothing+          (result, console) = runPureEff $ runConsolePure ["false", "owner"] $ resolve PromptsAllowed spec Map.empty Map.empty Map.empty (Map.singleton "feature" "true")+      case result of+        Right (inputs, _) -> (inputs Map.! "details") ^. #value `shouldBe` VText "owner"+        Left errs -> expectationFailure (show errs)+      console ^. #outputs `shouldBe` ["Other?", "Details? [skip]:"]+    it "rejects exhausted invalid optional answers" $ do+      let optional = feature & #required .~ False+          spec = RecipeInputSpec [optional] [mkPrompt "feature" "Feature?"] Nothing+          (result, _) = runPureEff $ runConsolePure ["bad", "bad", "bad"] $ resolve PromptsAllowed spec Map.empty Map.empty Map.empty Map.empty+      result `shouldBe` Left [CoercionFailed "feature" VTBool "bad"]+    it "adopts historical false through recipe coercion and rejects disagreeing consumers" $ do+      let second = primaryInstance "second"+          both = modules <> [(second, consumer, "/second")]+          check saved cli =+            fst $+              runPureEff $+                runConsolePureNonInteractive $+                  resolveRecipeWithPrompts PromptsForbidden False recipe both saved cli Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+          saved a b = Map.fromList [(primaryInstance "consumer", Map.singleton "feature" a), (second, Map.singleton "feature" b)]+      case check (saved "false" "no") Map.empty of+        Right (inputs, _) -> (inputs Map.! "feature") ^. #value `shouldBe` VBool False+        Left errs -> expectationFailure (show errs)+      case check (saved "false" "true") Map.empty of+        Left [ValidationFailed "feature" _] -> pure ()+        other -> expectationFailure (show other)+      case check (saved "false" "true") (Map.singleton "feature" "true") of+        Right (inputs, _) -> (inputs Map.! "feature") ^. #value `shouldBe` VBool True+        Left errs -> expectationFailure (show errs)+    it "validates the broadcast against each consumer declaration" $ do+      let invalid = consumer & #vars .~ [mkTextVar "feature" Nothing True & #validation .~ Just (ValMinLength 10)]+          (result, _) =+            runPureEff $+              runConsolePureNonInteractive $+                resolveRecipeWithPrompts PromptsForbidden False recipe [(primaryInstance "consumer", invalid, "/fixture")] Map.empty (Map.singleton "feature" "true") Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left [ValidationFailed "feature" _] -> pure ()+        other -> expectationFailure (show other)+    it "replays recorded choices before config and skips accepted optional omissions" $ do+      let optional = mkTextVar "details" Nothing False+          spec = RecipeInputSpec [feature, optional] [mkPrompt "details" "Details?"] (Just (Map.singleton "feature" "false"))+          (result, console) = runPureEff $ runConsolePure [] $ resolve PromptsAllowed spec Map.empty Map.empty Map.empty (Map.singleton "feature" "true")+      case result of+        Right (inputs, _) -> (inputs Map.! "feature") ^. #value `shouldBe` VBool False+        Left errs -> expectationFailure (show errs)+      console ^. #outputs `shouldBe` []+   describe "runPrompts" $ do     it "fills a required text variable with FromPrompt source" $ do       let decl = mkTextVar "project.name" Nothing True

@@ -108,6 +108,7 @@                  ],                commandReceipts = Map.empty,                checkoutCommands = [],+               recipeInputs = Nothing,                appliedAt = fixedTime              }          ]@@ -195,6 +196,7 @@       instances = composition ^. #instances,       commandReceipts = receipts,       checkoutCommands = [],+      recipeInputs = composition ^. #recipeInputs,       appliedAt = composition ^. #appliedAt     } @@ -230,6 +232,15 @@  spec :: Spec spec = do+  describe "recipe inputs" $ do+    forM_ [Nothing, Just Map.empty, Just (Map.singleton "feature" "false")] $ \inputs ->+      it ("roundtrips unknown, empty and false recipe state: " <> show inputs) $ do+        let manifest = manifestWithEveryOriginPosition & #applications %~ map (\app -> app & #recipeInputs .~ inputs)+        manifestFromJSON (manifestToJSON manifest) `shouldBe` Right manifest+    it "refuses to lose recipe input state through an older encoding" $ do+      let manifest = manifestWithEveryOriginPosition & #version .~ ManifestSchemaVersion 11 & #applications %~ map (\app -> app & #recipeInputs .~ Just Map.empty)+      manifestEncodingLoss manifest `shouldSatisfy` (not . null)+   -- The manifest is checked into version control and read on other machines,   -- so no origin it records may name a location that only exists on the   -- machine that wrote it. See@@ -267,7 +278,7 @@    describe "checkout command codec" $ do     let command = CheckoutCommand "demo" 0 "mkdir -p .local/setup" Nothing-        application commands = AppliedComposition (ApplicationId "setup") (AppliedModuleTarget "demo") (ProjectOrigin "modules/demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (ProjectOrigin "modules/demo") (Just "1") Map.empty] Map.empty commands fixedTime+        application commands = AppliedComposition (ApplicationId "setup") (AppliedModuleTarget "demo") (ProjectOrigin "modules/demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (ProjectOrigin "modules/demo") (Just "1") Map.empty] Map.empty commands Nothing fixedTime         manifest commands = emptyManifest fixedTime & #applications .~ [application commands]         mutateApp transform value = case value of           Aeson.Object fields -> case KeyMap.lookup "applications" fields of@@ -518,6 +529,7 @@                   ],                 commandReceipts = Map.singleton fingerprint receipt,                 checkoutCommands = [],+                recipeInputs = Nothing,                 appliedAt = fixedTime               }           application2 =@@ -532,6 +544,7 @@                 instances = [],                 commandReceipts = Map.empty,                 checkoutCommands = [],+                recipeInputs = Nothing,                 appliedAt = fixedTime2               }           fileRecord =@@ -702,6 +715,7 @@                 instances = [],                 commandReceipts = Map.empty,                 checkoutCommands = [],+                recipeInputs = Nothing,                 appliedAt = fixedTime               }           fileRecord = FileRecord (SHA256 "hash") "base" Template fixedTime Nothing mempty SharedWriteUnknown

@@ -63,6 +63,13 @@  spec :: Spec spec = do+  it "upgrades schema 11 with unknown recipe inputs without manufacturing answers" $ do+    let document = Aeson.object ["version" Aeson..= (11 :: Int), "applications" Aeson..= [Aeson.object ["producerOwned" Aeson..= True]]]+    case upgradeDocumentLosslessly (v 12) document of+      Left err -> expectationFailure (show err)+      Right (_, Aeson.Object fields) -> KeyMap.lookup "applications" fields `shouldBe` Just (Aeson.toJSON [Aeson.object ["producerOwned" Aeson..= True, "recipeInputs" Aeson..= Aeson.Null]])+      Right _ -> expectationFailure "expected manifest object"+   describe "the step registry" $ do     it "plans a contiguous path from every supported version to the current one" $       -- ADR 0014's mechanical gap check: a schema bump without its adjacent